ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SlyFaceCoque.vb
Revision: 130
Committed: Wed Jul 30 21:26:03 2008 UTC (16 years, 11 months ago) by bournival
File size: 32791 byte(s)
Log Message:
Une mise à jour, car on aura peut-être besoin de mon code.

File Contents

# User Rev Content
1 bournival 48 Imports SolidWorks.Interop
2     Imports SolidWorks.Interop.swconst
3     Imports SolidWorks.Interop.swpublished
4    
5 bournival 40 Public Class SlyFaceCoque
6     Inherits SuperFace
7    
8    
9 bournival 46 Private epaisseur As Double
10 bournival 40 Public materiau As Long
11     Public swAttribute As SldWorks.Attribute ' l'attribut qui contient l'épaisseur. et le matériau
12    
13     Private FlagFace_de_section As Integer = 99
14    
15     Sub New(ByRef swface As SldWorks.Face2)
16     MyBase.New(swface, 1) ' 1 car c'est une coque
17     End Sub
18    
19     Protected Overrides Sub Finalize()
20     Me.lst_Faces.Clear()
21     Me.lst_InterPoutre.Clear()
22     Me.lst_InterCoqueVolume.Clear()
23     MyBase.Finalize()
24     End Sub
25    
26    
27 bournival 130 Public Overrides Sub decouper()
28    
29     If lst_InterPoutre.Count = 0 Then Exit Sub ' sortir si on a pas d'intersection
30    
31    
32     ' les attributs ne sont pas updatés sur les faces (mais sur les arètes et les sommets c'est OK)
33     ' on mémorise l'attribut de la face et on la réapplique à la fin.
34    
35    
36     Dim i As Integer
37     Dim inter As InterPoutreCoque
38     Dim nb1 As Integer, nb2 As Integer, nb3 As Integer, nb5 As Integer
39     Dim poutre1 As SlyAretePoutre = Nothing, poutre3 As SlyAretePoutre = Nothing
40     Dim lst_poutre2 As New Collection
41     Dim aire As Double
42     Dim poutreTest As SlyAretePoutre
43    
44     Dim lst_coupeXinter As New Collection
45     Dim lst_coupeXPoutre As New Collection
46     Dim lst_coupeLinter As New Collections.Generic.List(Of InterPoutreCoque)
47     Dim lst_coupeLPoutre As New Collection
48     Dim lst_coupeCinter As New Collection
49     Dim lst_coupeCPoutre As New Collection
50    
51    
52     For Each inter In lst_InterPoutre
53     'MsgBox("On découpe l'intersection # " & inter.Numero)
54     'pour chaque intersection on peut avoir plusieurs poutres...
55     For i = 1 To inter.lst_sPoutre.Count
56     poutreTest = inter.lst_sPoutre.Item(i)
57     Select Case CInt(inter.lst_type.Item(i))
58     Case 1
59     If poutreTest.GetAireCarree > aire Then poutre1 = poutreTest
60     nb1 += 1
61     Case 2
62     lst_poutre2.Add(poutreTest)
63     nb2 += 1
64     Case 3
65     If poutreTest.GetAireCarree > aire Then poutre3 = poutreTest
66     nb3 += 1
67     Case 5 ' un poutre à faceDeSection
68     nb5 += 1
69     Case 6
70     MsgBox("Une extrémité de la poutre est avec un «Guide» alors que l'autre coté ne l'est pas. Ceci n'est pas programmé...")
71    
72     Case 22
73     ' on fait rien, mais c'est pour éviter le msgbox du case else...
74     Case Else
75     MsgBox("Problème dans découper de SlyFaceCoque, le type d'intersection n'est pas reconnu", MsgBoxStyle.Critical)
76     End Select
77     Next i
78    
79    
80    
81     If nb1 > 0 Then 'CoupeX(inter, poutre1) ' on coupe le x en premier
82     lst_coupeXinter.Add(inter)
83     lst_coupeXPoutre.Add(poutre1)
84     End If
85    
86    
87     For Each poutreTest In lst_poutre2 ' puis on coupe sur la longueur 'CoupeLong(inter, poutreTest)
88     lst_coupeLinter.Add(inter)
89     lst_coupeLPoutre.Add(poutreTest)
90     Next
91    
92     If nb3 > 0 Then 'CoupeCote(inter, poutre3) ' finalement on coupe sur les cotés
93     lst_coupeCinter.Add(inter)
94     lst_coupeCPoutre.Add(poutre3)
95     End If
96    
97     If nb5 = 1 And (nb1 > 0 Or nb2 > 0 Or nb3 > 0) Then
98     MsgBox("Problème, on a un type d'intersection impossible dans la vraie vie!", MsgBoxStyle.Exclamation, "Design impossible à obtenir en réalité...")
99     End If
100    
101    
102     lst_poutre2.Clear()
103     nb1 = 0 : nb2 = 0 : nb3 = 0
104    
105    
106     Next inter
107    
108    
109     ' maintenant on a toutes les lists d'intersections. On les coupe.
110     For i = 1 To lst_coupeXinter.Count
111     CoupeX(lst_coupeXinter.Item(i), lst_coupeXPoutre.Item(i))
112     Next
113    
114     For Each int As InterPoutreCoque In lst_coupeLinter ' i = 1 To lst_coupeLinter.Count
115     int.DecouperLong() 'CoupeLong(lst_coupeLinter.Item(i), lst_coupeLPoutre.Item(i))
116     Next
117    
118     For i = 1 To lst_coupeCinter.Count
119     CoupeCote(lst_coupeCinter.Item(i), lst_coupeCPoutre.Item(i))
120     Next
121    
122     ' ne devrait pas avoir ça avec une coque...
123     'If nb5 = 1 Then
124     ' If lst_InterPoutre.Count <> 1 Then MsgBox("Plus d'une intersection du type FacedeSection....")
125     ' CoupeFaceDeSection(lst_InterPoutre(1))
126     'End If
127    
128     End Sub
129    
130    
131     ' sub qui découpe les bords de la face.
132     Friend Sub CoupeCote(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre)
133     Dim pt3() As Double, pt3Original() As Double
134     Dim base(2) As Double, baseOriginal(2) As Double
135     Dim swEnt As sldworks.Entity
136     Dim Directionnel As Boolean, Flip As Boolean
137     Dim planReference As sldworks.RefPlane = Nothing
138     Dim sketchline As sldworks.SketchSegment
139     Dim swSketch As sldworks.Sketch
140     Dim DemiLargeur As Double
141     Dim g As Integer
142     Dim Face(1) As sldworks.Face2
143     Dim PlanEntity As sldworks.Entity = Nothing
144     Dim r(2) As Double
145     Dim sk(1) As Double
146     pt3Original = poutre.GetPoint3
147    
148    
149     swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
150     'swModel.SetAddToDB(True)
151     'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
152    
153     Dim vArete As Object
154     Dim cut As Double
155    
156     If Me.estPlan Then
157     ' la coque est plane, on met une esquisse dessus.#
158     PlanEntity = Me.SwFace
159    
160     ElseIf Me.estCylindre Then
161     ' on doit créer un plan de référence...
162    
163     ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
164     Dim vEdge As Object
165     Dim i As Integer
166     Dim swArete2() As sldworks.Edge
167     Dim swSommet As sldworks.Vertex
168    
169     vEdge = Me.SwFace.GetEdges
170     swArete2 = vEdge
171     swModel.ClearSelection2(True)
172    
173     While planReference Is Nothing
174     If UBound(swArete2) - 2 < i Then MsgBox("Dans CoupeLong, problème pour créer un plan avec 3 points. (La face est un FauxPlan)", MsgBoxStyle.Critical, "Le plan ne sera pas créé") : Exit While
175     swSommet = swArete2(i).GetStartVertex()
176     swEnt = swSommet
177     swEnt.Select4(False, Nothing)
178     swArete2(i + 1).GetStartVertex()
179     swEnt = swSommet
180     swEnt.Select4(True, Nothing)
181     swArete2(i + 2).GetStartVertex()
182     swEnt = swSommet
183     swEnt.Select4(True, Nothing)
184     i += 1
185     planReference = swModel.CreatePlaneThru3Points3(False)
186     PlanEntity = planReference
187     End While
188    
189    
190     Else ' la face est une spline
191     MsgBox("Dans coupeCoté, la face est un type de surface qui n'est pas encore traité")
192     End If
193    
194    
195     baseOriginal(0) = inter.x : baseOriginal(1) = inter.y : baseOriginal(2) = inter.z
196    
197    
198     Dim Psi As Double
199     Dim u(2) As Double, v(2) As Double, usketch(2) As Double, vsketch(2) As Double
200     Dim Arete As sldworks.Edge = Nothing
201     Dim retval As Object
202     u = poutre.GetOrientation(inter.x, inter.y, inter.z)
203    
204    
205     vArete = Me.SwFace.GetEdges
206    
207     For Each Arete In vArete
208     If Commun.Distance(Arete, inter.x, inter.y, inter.z) < Epsilon Then Exit For
209     Next
210    
211     retval = Arete.GetClosestPointOn(inter.x, inter.y, inter.z)
212     retval = Arete.Evaluate(retval(3))
213     v(0) = retval(3) : v(1) = retval(4) : v(2) = retval(5)
214    
215    
216    
217    
218     For g = 0 To 1
219    
220     PlanEntity.Select(False)
221     swModel.InsertSketch2(True)
222     swSketch = swModel.GetActiveSketch2
223    
224     pt3 = Commun.TransfertModelSketch(swSketch, pt3Original)
225     usketch = Commun.TransfertModelSketch(swSketch, u) ' on les met dans le plan du sketch
226     vsketch = Commun.TransfertModelSketch(swSketch, v)
227     base = Commun.TransfertModelSketch(swSketch, baseOriginal)
228     Psi = Outils_Math.cosdir(usketch, vsketch)
229    
230     Dim a As Double, b As Double
231     'longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
232     'If pt3(1) = 0 Then a = 999999999999 Else a = Math.Abs(poutre.GetD2() * longueur / pt3(1))
233     'If pt3(0) = 0 Then b = 999999999999 Else b = Math.Abs(poutre.GetD1() * longueur / pt3(0))
234     ' À revoir. Si le plan est un cylindre ça marche plus. sans compter l'épaisseur de la poutre.
235     ' pour l'instant je prend la plus prtite valeur...
236     a = poutre.GetD1
237     b = poutre.GetD2
238     DemiLargeur = Math.Min(a, b)
239     cut = DemiLargeur / Math.Sin(Pi / 2 - Psi)
240    
241    
242     Dim P1(1) As Double
243     Dim P2(1) As Double
244     Dim P3(1) As Double
245     Dim P4(1) As Double
246     Dim Ptest(2) As Double
247    
248    
249     If g = 0 Then
250     P1(0) = -cut
251     P1(1) = -cut '* mult ' 0
252     P2(0) = 0
253     P2(1) = -cut '* mult ' 0
254     P3(0) = 0
255     P3(1) = cut 'Intersections.Taille mult
256     P4(0) = -cut
257     P4(1) = cut 'Intersections.Taille mult
258     sk(0) = -Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
259    
260     Else
261     P1(0) = 0
262     P1(1) = -cut '* mult '0
263     P2(0) = +cut
264     P2(1) = -cut '* mult '0
265     P3(0) = +cut
266     P3(1) = cut 'Intersections.Taille mult
267     P4(0) = 0
268     P4(1) = cut 'Intersections.Taille mult
269     sk(0) = Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
270    
271     End If
272    
273     P1 = Outils_Math.Rotation2D(vsketch, P1)
274     P2 = Outils_Math.Rotation2D(vsketch, P2)
275     P3 = Outils_Math.Rotation2D(vsketch, P3)
276     P4 = Outils_Math.Rotation2D(vsketch, P4)
277     sk = Outils_Math.Rotation2D(vsketch, sk)
278    
279     sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P2(0) + base(0), P2(1) + base(1), 0)
280     sketchline = swModel.CreateLine2(P2(0) + base(0), P2(1) + base(1), 0, P3(0) + base(0), P3(1) + base(1), 0)
281     sketchline = swModel.CreateLine2(P3(0) + base(0), P3(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
282     sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
283    
284     swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
285     swModel.ClearSelection2(True)
286     'swEnt = Me.SwFace : swEnt.Select2(False, 1)
287     swEnt = swSketch : swEnt.Select2(False, 4)
288     Me.SelectionnerToutes(1, True)
289    
290     swModel.InsertSplitLineProject(Directionnel, Flip)
291     r = Commun.TransfertSketchToModel(swSketch, sk)
292     Face(g) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, , True)
293     'If Face(g) Is Nothing Then
294     'swSketch.Select(False)
295     'swModel.EditDelete()
296     'End If
297    
298     Next g
299    
300    
301    
302     ' mettre les mini-poutres
303     Dim vEdge2 As Object
304     Dim swArete As sldworks.Edge
305     Dim vPoint As Object
306     Dim Mini1 As sldworks.Edge = Nothing, Mini2 As sldworks.Edge = Nothing
307    
308    
309     ' 1 - trouver les 2 arrères dont l'orientation est la même (ou l'inverse) que le v
310     For g = 0 To 1
311     If Not Face(g) Is Nothing Then
312     vEdge2 = Face(g).GetEdges()
313    
314    
315     ' construire u
316     For Each swArete In vEdge2
317     If Commun.Distance(swArete, inter.x, inter.y, inter.z) < Epsilon Then
318     ' l'arête touche à l'intersection,
319     vPoint = swArete.GetClosestPointOn(inter.x, inter.y, inter.z)
320     vPoint = swArete.Evaluate(vPoint(3))
321     u(0) = vPoint(3) : u(1) = vPoint(4) : u(2) = vPoint(5)
322    
323     If Outils_Math.CompareSens(v, u) Then
324     ' l'arète doit être une mini-poutre
325     If Mini1 Is Nothing Then Mini1 = swArete : Exit For Else Mini2 = swArete : Exit For
326     End If
327     End If
328    
329     Next
330    
331     End If
332     Next
333    
334     swEnt = Mini1
335     If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
336    
337     If Not Mini2 Is Nothing Then
338     swEnt = Mini2
339     If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
340     End If
341    
342     swModel.SetInferenceMode(True) '
343     'swModel.SetAddToDB(False)
344     'swModel.SetDisplayWhenAdded(True) '
345     End Sub
346    
347    
348    
349 bournival 40 ''' <summary>
350     ''' sub qui CRÉÉ une instance de la classe InterPoutreCoque si et seulement si il n'en existe pas avant. S'il en existe alors on update la classe déjà existante.
351     ''' </summary>
352     ''' <param name="sPoutre">La SlyPoutre</param>
353     ''' <param name="xyz1">Laposition du pount d'intersection</param>
354     ''' <param name="tipe">=1 si on découpe en X, 2 si à l'intérieur, 3 si à l'extérieur</param>
355     ''' <returns>La classe d'intersection</returns>
356     ''' <remarks>dans tous les cas on retourne la classe (pour pouvoir l'ajouter à la poutre...)</remarks>
357     Public Function AjouterInterPoutre(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterPoutreCoque
358    
359     Dim int As InterPoutreCoque
360    
361     For Each int In lst_InterPoutre
362     If Math.Abs(int.x - xyz1(0)) < Epsilon And Math.Abs(int.y - xyz1(1)) < Epsilon And Math.Abs(int.z - xyz1(2)) < Epsilon Then
363     ' on a un point déjà existant,
364     int.lst_sPoutre.Add(sPoutre)
365     int.lst_type.Add(tipe)
366     Return int
367     End If
368     Next
369    
370    
371     ' si on est ici c'est que l'on doit créer l'intersection
372     int = New InterPoutreCoque
373    
374     int.x = xyz1(0)
375     int.y = xyz1(1)
376     int.z = xyz1(2)
377    
378     int.lst_sPoutre.Add(sPoutre)
379     int.lst_type.Add(tipe)
380     int.sFaceCoque = Me
381     lst_InterPoutre.Add(int)
382     Return int
383    
384     End Function
385    
386    
387    
388 bournival 48
389 bournival 40 Public Function PossedeFaceDeSection() As Boolean
390    
391     If Not Me.FlagFace_de_section = 99 Then Return CBool(Me.FlagFace_de_section)
392     Dim retour As Double
393    
394     Dim p As SldWorks.Parameter
395     Try
396     p = swAttribute.GetParameter("Flag")
397     Catch ex As Exception
398 bournival 130 MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'épaissuer, la coque n'a peut-être pas d'attributs...")
399 bournival 40 Return Nothing
400     End Try
401    
402     retour = p.GetDoubleValue
403     Me.FlagFace_de_section = retour
404     If retour = 1 Then Return True Else Return False
405    
406     End Function
407    
408    
409 bournival 46 ''' <summary>
410     ''' Donne l'épaisseur de la coque
411     ''' </summary>
412 bournival 130 ''' <value>La valeur de l'épaisseur ATTENTION: voir remarques</value>
413     ''' <returns>L'épaisseur de la coque</returns>
414     ''' <remarks>La propriété ne peut être un readonly à cause d'une petite exception, normalement on ne devrait pas setter l'épaisseur de la coque</remarks>
415     Public Property GetEpaisseur() As Double
416 bournival 46 Get
417 bournival 130
418 bournival 46 If Not Me.epaisseur = 0 Then Return Me.epaisseur : Exit Property ' pour optimiser
419 bournival 40
420 bournival 130 Dim p As sldworks.Parameter
421 bournival 40
422 bournival 46 Try
423     p = swAttribute.GetParameter("Ep")
424     Catch ex As Exception
425     MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'épaisseur, la coque n'a peut-être pas d'attributs...")
426     Return 0
427     End Try
428     Me.epaisseur = p.GetDoubleValue
429     Return p.GetDoubleValue
430 bournival 130
431 bournival 46 End Get
432 bournival 130
433     Set(ByVal value As Double)
434     Me.epaisseur = value
435     ' faut aussi changer le paramètre de l'attribut
436     Dim p As sldworks.Parameter = Me.swAttribute.GetParameter("Ep")
437     p.SetDoubleValue(Me.epaisseur)
438     End Set
439 bournival 46 End Property
440 bournival 40
441    
442 bournival 46
443 bournival 40 Public Function GetMateriau() As String
444     If Not Me.materiau Then Return Me.materiau : Exit Function ' pour optimiser
445    
446    
447     Dim p As SldWorks.Parameter = Nothing
448    
449     Try
450     p = swAttribute.GetParameter("M")
451     Catch ex As Exception
452     MsgBox("N'arrive pas à se lier à l'attribut pour obtenir le matériau, la coque n'a peut-être pas d'attributs...")
453     End Try
454     Me.materiau = p.GetStringValue
455     Return p.GetStringValue
456     End Function
457    
458     Public Function GetAttribute() As SldWorks.Attribute
459     Dim ent As SldWorks.Entity
460     Dim attr As SldWorks.Attribute = Nothing
461    
462     Try
463     ent = lst_Faces.Item(1)
464     attr = ent.FindAttribute(Intersections.DefAttrRCCoque, 0)
465     Me.swAttribute = attr
466     Catch ex As Exception
467     MsgBox("ERREUR! Une coque sans attributs !", MsgBoxStyle.Critical)
468     End Try
469     If IsNothing(attr) Then ' on a trouvé un attribut de coque
470     MsgBox("Une coque sans attributs !")
471     End If
472     Return attr
473     End Function
474    
475     Private Function PointInterne(ByRef P1() As Double, ByRef P2() As Double, ByRef centreX As Double, ByRef centreY As Double) As Double()
476     Dim b(1) As Double
477     Dim c(1) As Double
478     Dim d(1) As Double
479     b(0) = P1(0) - centreX
480     b(1) = P1(1) - centreY
481     c(0) = P1(0) - centreX
482     c(1) = P1(1) - centreY
483    
484     b = Outils_Math.unitaire(b)
485     c = Outils_Math.unitaire(c)
486    
487     d(0) = ((b(0) + c(0)) / 2) * 50 * Epsilon
488     d(1) = ((b(0) + c(0)) / 2) * 50 * Epsilon
489    
490     Return d
491    
492     End Function
493    
494     ' cette sub ajoute LES constantes de la coque aux nom de l'entité.
495     Public Sub AddConstantes()
496     ' cette sub ajoute LES constantes de la coque aux nom de l'entité.
497     ' on suppose qu'il n'y en a pas déjà
498     ' tout ce que j'ai à faire c'est de modifier la propriété nom.
499    
500     'Format(valeur, "0.00000e+000")
501     Dim epaisseur As Double
502    
503    
504     epaisseur = Me.GetEpaisseur()
505     If epaisseur <= 0 Then
506     MsgBox("Attention, une coque n'a pas d'épaisseur ou une épaisseur négative, celle-ci est affichée en rouge sur le modèle découpé. Une valeur de 1 a été utilisée par défaut")
507     epaisseur = 1
508     Dim ent As SldWorks.Entity
509     ent = Me.swFace : ent.Select4(False, Nothing)
510     swModel.SelectedFaceProperties(1, 0, 0, 0, 0, 0, 0, False, "")
511     End If
512    
513    
514     nom = nom & "¢" & Format(epaisseur, "0.00000e+000") & "MA" & Format(materiau, "00")
515    
516     ' attention, s'il y a une intersection, je dois la noter et l'ajouter au nom....
517     Dim c As Integer
518     For c = 1 To Len(nom)
519     If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
520     Next c
521     End Sub
522    
523    
524    
525 bournival 130 Protected Function UpdateApresSplit(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre, ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef Plan As sldworks.RefPlane, Optional ByRef FI As Boolean = False, Optional ByVal VientDeCoupeCote As Boolean = False) As sldworks.Face2
526 bournival 40
527     ' le pointeur Me.swFace pointe soit sur une face, soit sur la face originale soit la face découpée
528     ' cette procédure doit créer une nouvelle SlyFaceCoque
529     ' et tout ce que j'ai c'est un pointeur, et je sais même pas lequel.
530     ' la fonction ne créée pas de nouvelles slyEntités.
531     ' si le découpage donne 3 faces ou plus, elles sont placées dans lst_AutreFaces
532    
533    
534     ' 1 - on obtient les 2 nouvelles faces,
535     Dim vFace As Object
536 bournival 130 Dim Face1 As sldworks.Face2
537     Dim Face2 As sldworks.Face2
538     Dim FaceInterne As sldworks.Face2
539     Dim FaceExterne As sldworks.Face2
540     Dim swFeat As sldworks.Feature
541 bournival 40
542     swFeat = swModel.FeatureByPositionReverse(0)
543     vFace = swFeat.GetFaces
544    
545     If vFace Is Nothing Then Return Nothing ' le code nothing veut dire que la face n'a pas été coupée.
546    
547     Face1 = vFace(0)
548     Face2 = vFace(1)
549    
550     Try ' vérification
551 bournival 130 Dim face3 As sldworks.Face2
552 bournival 40 Dim i As Integer
553     'Dim slyFaceSupplémentaire As SlyFaceCoque ' la raison du pourquoi on doit avoir 2 sous-routines
554    
555     For i = 2 To 1000
556     face3 = vFace(i)
557     Me.lst_Faces.Add(face3)
558     Next i
559    
560     'MsgBox("Problème, on a au moins 3 face dans le update après le découpage", MsgBoxStyle.Critical)
561     Catch ex As Exception
562     ' tout est normal...
563     End Try
564    
565     ' SECRET 1.999 ' c'est pas scientifique mais ça peut marcher
566     If Math.Abs(Face1.GetArea) > Math.Abs(10 * Face2.GetArea) Then
567     FaceInterne = Face2
568     FaceExterne = Face1
569     ElseIf Math.Abs(Face1.GetArea) < Math.Abs(10 * Face2.GetArea) Then
570     FaceInterne = Face1
571     FaceExterne = Face2
572     Else
573    
574    
575     '' 2 - on a un point, on trouve quelle face est la plus proche.
576     If Commun.Distance(Face1, x, y, z) < Commun.Distance(Face2, x, y, z) Then
577     FaceInterne = Face1
578     FaceExterne = Face2
579     Else
580     FaceInterne = Face2
581     FaceExterne = Face1
582     End If
583     End If
584    
585     Me.lst_Faces.Add(FaceInterne)
586     Me.lst_Faces.Add(FaceExterne)
587    
588     '' 3 - on créé une nouvelle coque (intérieure) et on lui donne les propriétés originales et on met dans la liste des coques
589     'Me.swFace = FaceExterne
590     Dim aire As Double
591     aire = FaceExterne.GetArea
592    
593     ' ************************************************
594     ' pour placer un attribut sur la face interne
595 bournival 130 Dim attr As sldworks.Attribute
596     Dim swent As sldworks.Entity
597 bournival 40 Static no As Integer
598    
599     If FI Then
600     Dim nom2 As String = "FaceInterne" & no
601    
602     swent = FaceInterne
603     attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
604    
605     If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
606    
607     While attr Is Nothing
608     no += 1
609     nom2 = "FaceInterne" & CStr(no)
610     attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
611     End While
612     GererDossiers("FaceInternes", nom2)
613     no += 1
614     ElseIf Flag = 2 Then ' on a un channel, on fait les 2 options
615     Dim nom2 As String = "FaceInterne" & no
616    
617     swent = FaceInterne
618     attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
619    
620     If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
621    
622     While attr Is Nothing
623     no += 1
624     nom2 = "FaceInterne" & CStr(no)
625     attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
626     End While
627     GererDossiers("FaceInternes", nom2)
628     no += 1
629     MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
630     Else
631 bournival 130 If Not VientDeCoupecote Then MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
632 bournival 40 End If
633    
634     ' ************ l'attribut de la condition aux limites *******************
635     'attr = Nothing
636     'Dim nom3 As String
637     'Dim p As SldWorks.Parameter
638     'If Not Me.condition = "" Then
639     ' nom3 = "CLc_" & no & "_" & Me.nom & " " & Me.condition
640     ' attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
641    
642     ' While attr Is Nothing
643     ' If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, FaceInterne, nom3, 0, 0)
644     ' If attr Is Nothing Then nom3 = nom3 & CStr(Timer)
645     ' End While
646    
647     ' p = attr.GetParameter("CL")
648     ' p.SetStringValue(Me.condition)
649    
650     'End If
651     ' GererDossiers("Conditions Aux Limites", nom3)
652     ' *****************************************************
653     Return FaceInterne
654    
655    
656     End Function
657    
658     Public Sub SetAttributDeCoque(ByRef epaisseur As Double, Optional ByRef materiau As String = Nothing)
659     Dim nom As String
660     Dim swFace As SldWorks.Face2
661     Dim swent As SldWorks.Entity
662     Dim no As Long
663     Dim Attr As SldWorks.Attribute
664    
665     swFace = Me.SwFace
666     swent = swFace
667    
668    
669     Try
670     Attr = swent.FindAttribute(Intersections.DefAttrRCCoque, 0) ' si l'attribut existe déjà on pointe dessus.
671     Catch ex As Exception
672     'MsgBox("N'arrive pas à se lier à l'attribut!", MsgBoxStyle.Information, "SetAttributsDePoutre")
673     Exit Sub
674     End Try
675    
676     If Attr Is Nothing Then Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 2) ' 0 = swThisconfig
677    
678     While Attr Is Nothing
679     no += 1
680     nom = "RCCoque" & CStr(no)
681     Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 0)
682     If no > 100000 Then MsgBox("N'arrive pas à créer l'attribut sur la coque après 100 000 essais...", MsgBoxStyle.Exclamation, "Problème dans CreationAttributPourPoutre")
683    
684     End While
685    
686    
687     Dim ParamM As SldWorks.Parameter
688     Dim ParamEp As SldWorks.Parameter
689    
690     ParamM = Attr.GetParameter("M")
691     ParamEp = Attr.GetParameter("Ep")
692    
693     If materiau IsNot Nothing Then ParamM.SetStringValue2(materiau, 2, "") ' swAllConfiguration = 2
694     ParamEp.SetStringValue2(epaisseur, 2, "")
695    
696     End Sub
697    
698    
699 bournival 130 Protected Sub CoupeX(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre)
700     Dim swEnt As sldworks.Entity = Nothing
701     Dim Directionnel As Boolean, Flip As Boolean
702     Dim Faces(3) As sldworks.Face2
703     Dim r(2) As Double
704     Dim LaSurface As sldworks.Surface
705     Dim sens As Boolean
706     Dim p(2) As Double
707     Dim retour() As Double
708    
709     'swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
710     'swModel.SetAddToDB(True)
711     'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
712    
713    
714     ' l'idée est de sélectionner le point et l'arète puis d'utiliser CreatePlanePerCurveAndPassPoint3
715     Dim planReference As sldworks.RefPlane
716     Dim swsketch As sldworks.Sketch
717     Dim swSommet As sldworks.Vertex, swSommet2 As sldworks.Vertex
718     Dim pointdeb(2) As Double, pointfin(2) As Double
719    
720     'swModel.Extension.SelectByID2("", "POINTREF", inter.x, inter.y, inter.z, False, 0, Nothing, 0)
721     ' faut vraiment sélectionner le bon point...
722     swSommet = poutre.swArete.GetStartVertex()
723     swSommet2 = poutre.swArete.GetEndVertex()
724     If swSommet Is Nothing Then
725     MsgBox("On a un cercle ou courbe sans sommets, dans coupeX, pas encore traité. Ne peut pas mettre un plan si pas de sommet")
726     Else
727     If Distance(swSommet, inter.x, inter.y, inter.z) < Epsilon Then
728     swEnt = swSommet
729     ElseIf Distance(swSommet2, inter.x, inter.y, inter.z) < Epsilon Then
730     swEnt = swSommet2
731     Else
732     MsgBox("Dans coupeX, l'intersection n'est pas sur un sommet. Pas encore traité. Nécessite de créer un point au coordonnées d'intersection")
733     End If
734     End If
735    
736     swEnt.Select4(False, Nothing)
737     swEnt = poutre.swArete
738     swEnt.Select(True)
739    
740     If Me.estPlan Or Me.estFauxPlan(inter.x, inter.y, inter.z) Then
741     ' si la coque est plane alors on projette le plan de référence des deux cotés, sinon on doit le décaler vers le bas
742     planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
743     Directionnel = False
744     Flip = False
745     ElseIf Me.estCylindre Then
746     ' on a un cylindre, on ne projette pas des 2 cotés. On créé un plan, puis un autre plus bas pour ensuite projeter d'un seul coté.
747     Dim PlanDessus As sldworks.RefPlane
748     Dim Rayon As Double, L As Double, B As Double, phi As Double, dist As Double, temp1 As Double, temp2 As Double
749     Dim u(2) As Double, v(2) As Double
750     PlanDessus = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
751     temp1 = poutre.GetD1
752     temp2 = poutre.GetD2
753     L = Math.Sqrt(temp1 * temp1 + temp2 * temp2)
754     Rayon = Me.GetRayonCylindre()
755     u = poutre.GetOrientation(inter.x, inter.y, inter.z)
756     v = Me.GetNormale(inter.x, inter.y, inter.z)
757     phi = -(Math.Acos(Outils_Math.cosdir(u, v)))
758     B = Math.Abs(L / 2 * Math.Sin(phi))
759     dist = Rayon - Math.Sqrt(Rayon * Rayon - ((L / 2) * (L / 2))) + B
760     If dist < 0 Then MsgBox("Gros problème pour couper le cylindre, la poutre est plus grosse!!!!!!", MsgBoxStyle.Critical) : Exit Sub
761    
762     swEnt = PlanDessus
763     swEnt.Select(False)
764     Directionnel = True
765    
766     Flip = Flipper(PlanDessus, inter)
767    
768     planReference = swModel.CreatePlaneAtOffset3(dist * 2, Flip, True)
769     Else
770     MsgBox("La coque n'est ni un cylindre, ni un plan" & vbCr & "Le résultat n'est pas certain...", MsgBoxStyle.Information, "Avertissement")
771     planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
772     Directionnel = False
773     Flip = False
774     End If
775    
776    
777    
778     LaSurface = Me.SwFace.GetSurface()
779     sens = Me.SwFace.FaceInSurfaceSense()
780    
781     ' skx est la coordonnée du point de ref en coord de sketch, Rx est le point de référence dans le repère global.
782     Dim i As Integer, MettreFI As Boolean
783     Dim swFeat As sldworks.Feature
784    
785     For i = 0 To 1
786    
787     swEnt = planReference
788     swEnt.Select(False)
789     swModel.InsertSketch2(False)
790     swModel.ClearSelection2(True)
791     swFeat = swModel.FeatureByPositionReverse(0)
792     swModel.SelectByID(swFeat.Name, "SKETCH", 0, 0, 0)
793     swModel.EditSketch()
794     swsketch = swModel.GetActiveSketch2
795    
796     p(0) = inter.x : p(1) = inter.y : p(2) = inter.z
797     retour = Commun.TransfertModelSketch(swsketch, p)
798    
799    
800     r = DessineSectionPoutre(poutre, retour(0), retour(1), i + 1, swsketch, inter, MettreFI)
801     swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
802     swModel.ClearSelection2(True)
803    
804     Dim face As sldworks.Face2
805     For Each face In Me.lst_Faces
806     swModel.ClearSelection2(True)
807     swEnt = face : swEnt.Select2(False, 1)
808     swEnt = swsketch : swEnt.Select2(True, 4)
809     swModel.InsertSplitLineProject(Directionnel, Flip)
810     Next
811    
812    
813     Me.SwFace.DetachSurface()
814     Me.SwFace.AttachSurface(LaSurface, sens)
815    
816     Faces(i) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, MettreFI)
817     Commun.MettreUnPoint(r(0), r(1), r(2))
818    
819     If Faces(i) Is Nothing Then
820     swEnt.Select(False)
821     swModel.EditDelete()
822     End If
823     If Flag = 2 Then Flag = 0 : Exit For
824    
825     Next i
826     End Sub
827    
828    
829 bournival 40 End Class
830