ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SuperFace.vb
Revision: 40
Committed: Mon Aug 20 21:30:28 2007 UTC (17 years, 8 months ago) by bournival
File size: 85633 byte(s)
Log Message:
Projet de these de Sylvain Bournival. Attention projet VB.

File Contents

# User Rev Content
1 bournival 40
2    
3     Public Class SuperFace
4     Inherits SuperEntite
5    
6     'Public swFace As SldWorks.Face2
7     Private Shared compteur As Long
8     Private Shared no As Long
9    
10     Friend Flag As Integer = 0 ' = 20 si on a une coupeLong
11    
12    
13     Friend lst_Faces As New Collections.Generic.List(Of SldWorks.Face2) ' une liste de faces supplémentaires si me.swFace est coupée en 3.
14     Friend lst_InterPoutre As New Collection() ' liste des poutres qui intersectionnent
15     Friend lst_InterCoqueVolume As New Collections.Generic.List(Of InterCoqueVolume) ' liste des intersections avec d'autres faces
16     Friend lst_InterCoqueCoque As New Collections.Generic.List(Of InterCoqueCoque)
17    
18    
19     Friend AttributCL As SldWorks.Attribute ' une l'attribut de condition aux imites qui doit être updaté
20     Private swSurface As SldWorks.Surface
21    
22    
23     ''' <summary>
24     ''' Renvoie le nombre de swFaces qui composent cette superface
25     ''' </summary>
26     ''' <value></value>
27     ''' <returns></returns>
28     ''' <remarks></remarks>
29     Public ReadOnly Property GetNbFaces() As Long
30     Get
31     Return lst_Faces.Count
32     End Get
33     End Property
34    
35    
36    
37     ''' <summary>
38     ''' New pour un encapsulateur temporaire de face
39     ''' </summary>
40     ''' <param name="Face"></param>
41     ''' <param name="encapsulateur"></param>
42     ''' <remarks></remarks>
43     Public Sub New(ByRef Face As SldWorks.Face2, ByRef encapsulateur As Boolean)
44     lst_Faces.Add(Face)
45     End Sub
46    
47     Friend Sub New(ByRef face As SldWorks.Face2, Optional ByVal tip As Integer = 0)
48     Me.AjouterFace(face)
49     Select Case tip
50     Case Commun.tipe_e.Volume
51     nom = "Face" & compteur
52     Case Commun.tipe_e.coque
53     nom = "FaceCoque" & compteur
54     End Select
55     nomOrig = nom
56     compteur = compteur + 1
57     End Sub
58    
59    
60     Friend Overridable 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) As SldWorks.Face2
61     MsgBox("La fonction non overridée a été appelée!")
62     Return Nothing
63     End Function
64    
65     Friend Overridable Function UpdateApresSplit(ByRef inter As InterPoutreVolume, 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) As SldWorks.Face2
66     MsgBox("La fonction non overridée a été appelée!")
67     Return Nothing
68     End Function
69    
70     ''' <summary>
71     ''' Sub qui ajoute des mini-poutres à la section entre le sommet de la poutre et un point de la face interne
72     ''' </summary>
73     ''' <param name="poutre">La poutre principale</param>
74     ''' <param name="FaceInterne">La face où il faut ajouter UNE mini-poutre</param>
75     ''' <param name="x1">Coordonnée en x du point d'intersection</param>
76     ''' <param name="y1"></param>
77     ''' <param name="z1"></param>
78     ''' <remarks>On pourrait ajouter plus d'une mini-poutre.</remarks>
79     Friend Sub AjouterMiniPoutresSurFaceInterne(ByRef poutre As SlyAretePoutre, ByRef FaceInterne As SldWorks.Face2, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double)
80     Dim x2 As Double, y2 As Double, z2 As Double
81     Dim swSketch As SldWorks.Sketch
82     Static k As Integer
83     Dim swEnt As SldWorks.Entity
84     Dim p As SldWorks.Parameter
85     Dim refCourbe As SldWorks.ReferenceCurve
86     Dim feat As SldWorks.Feature
87     Dim attr As SldWorks.Attribute
88    
89     ' 2 trouver un sommet ou un point sur la face interne.
90     Dim swArete As SldWorks.Edge
91     Dim swSommet2 As SldWorks.Vertex
92    
93     swArete = FaceInterne.GetFirstLoop.GetFirstCoEdge.getedge
94     swSommet2 = swArete.GetStartVertex()
95    
96     If swSommet2 Is Nothing Then ' un celcle (ou ellipse)
97     Dim retval As Object
98     retval = swArete.Evaluate(0) ' il va y avor un LC point anyway...
99     x2 = retval(0)
100     y2 = retval(1)
101     z2 = retval(2)
102    
103     Else
104     Dim retval As Object
105     retval = swSommet2.GetPoint()
106     x2 = retval(0)
107     y2 = retval(1)
108     z2 = retval(2)
109     End If
110    
111    
112     ' 3 faire une mini-poutre entre les 2
113    
114     swModel.Insert3DSketch2(True)
115     swModel.CreateLine2(x1, y1, z1, x2, y2, z2)
116     swSketch = swModel.GetActiveSketch2()
117     swModel.Insert3DSketch2(True)
118     swEnt = swSketch : swEnt.Select2(False, 1)
119     swModel.InsertCompositeCurve()
120    
121     ' reste à lui mettre les propriétés de mini-poutres
122     feat = swModel.FeatureByPositionReverse(0)
123     refCourbe = feat.GetSpecificFeature2
124     swArete = refCourbe.GetFirstSegment ' y'a juste un segment
125    
126     swEnt = swArete
127     Dim NomAttr As String
128     NomAttr = "miniPoutre" & Me.nom & k
129    
130     attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, swArete, NomAttr, 0, 0)
131     ' mettre les propriétés de la mini-poutre
132     ' attention, elle ne doit pas avoir de masse, sa section est alors Mini...
133    
134     p = attr.GetParameter("As")
135     p.SetDoubleValue2(-7, 2, "")
136     Commun.GererDossiers("Poutres", NomAttr)
137     k += 1
138    
139    
140     End Sub
141    
142    
143     Friend Overridable Function AjouterInterFace(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterCoqueVolume
144     ' sub qui CRÉÉ une instance de la classe InterFaceFace si et seulement si il n'en existe pas avant
145    
146    
147     'Dim int As InterFaceFace
148    
149     ' créez la routine qui ignore la création de
150     Return Nothing ' pout l'instant
151     End Function
152    
153    
154    
155     Shared Sub reinitialiser()
156     compteur = 0
157     End Sub
158    
159     Public Overrides Sub SaveNom()
160     ' procédure qui enregistre le nom et qui , pour l'instant ne tient pas compte des conditions aux limites
161     Dim ent As SldWorks.Entity
162     Dim i As Long
163     Dim nomtemp As String
164     'For i = 1 To Me.lst_Faces.Count
165     For Each swFace As SldWorks.Face2 In Me.lst_Faces
166     ent = swFace
167     Dim retval As Boolean
168     If Me.lst_Faces.Count > 1 Then nomtemp = nom & "-" & Chr(i + 96) Else nomtemp = nom
169     retval = swPart.SetEntityName(ent, nomtemp)
170     If retval = False Then
171     Dim nom2 As String
172     'Dim swface As SldWorks.Face2
173     'swface = ent
174     'If Me.SwFace Is swface Then MsgBox("La même face!")
175     nom2 = swPart.GetEntityName(ent)
176     'MsgBox("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom ( " & nom2 & " ) " & Chr(13) & "Et on veut écrire à la place --> " & nomtemp, MsgBoxStyle.Critical, "Problème dans le setID de SlyFaceVol")
177     Debug.Print("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom ( " & nom2 & " ) " & Chr(13) & "Et on veut écrire à la place --> " & nomtemp, MsgBoxStyle.Critical, "Problème dans le setID de SlyFaceVol")
178     End If
179     Next
180    
181    
182    
183     End Sub
184    
185    
186     Public Function GetNormale(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double()
187     Dim surf As SldWorks.Surface
188     Dim retval As Object
189     Dim temp(2) As Double
190    
191     surf = Me.lst_Faces.Item(0).GetSurface
192     retval = surf.EvaluateAtPoint(x, y, z)
193    
194     If retval Is Nothing Then MsgBox("Erreur, dans le Getnormal de la face, le point ne semble pas être sur la face")
195    
196     temp(0) = retval(0)
197     temp(1) = retval(1)
198     temp(2) = retval(2)
199    
200     Return temp
201     End Function
202     Public Function GetNormaleSurface(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double()
203     Dim surf As SldWorks.Surface
204     Dim retval As Object = Nothing
205     Dim temp(2) As Double
206    
207     surf = Me.lst_Faces.Item(0).GetSurface
208     retval = surf.EvaluateAtPoint(x, y, z)
209    
210     temp(0) = retval(0)
211     temp(1) = retval(1)
212     temp(2) = retval(2)
213    
214     Return temp
215     End Function
216    
217    
218    
219     Public Function GetRayonCourbureMax(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
220     Dim surf As SldWorks.Surface
221     Dim retval As Object
222     Dim temp As Double
223    
224     surf = Me.lst_Faces.Item(0).GetSurface
225     retval = surf.EvaluateAtPoint(x, y, z)
226    
227     temp = retval(9)
228    
229     Return temp
230     End Function
231    
232     Public Function GetRayonCourbureMin(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
233     Dim surf As SldWorks.Surface
234     Dim retval As Object
235     Dim temp As Double
236    
237     surf = Me.lst_Faces.Item(0).GetSurface
238     retval = surf.EvaluateAtPoint(x, y, z)
239    
240     temp = retval(10)
241    
242     Return temp
243     End Function
244    
245     ' si la surface est un cylindre, retourne son rayon. Plante ou valeur aléatoire si pas un cylindre
246     Public Function GetRayonCylindre() As Double
247     Dim surf As SldWorks.Surface
248     Dim retval As Object
249     Dim temp As Double
250    
251     surf = Me.lst_Faces.Item(0).GetSurface
252     retval = surf.CylinderParams
253    
254     temp = retval(6)
255    
256     Return temp
257     End Function
258    
259    
260     ''' <summary>
261     ''' Retourne vrai si une face est plane
262     ''' </summary>
263     ''' <returns></returns>
264     ''' <remarks></remarks>
265     Public Function estPlan() As Boolean
266     Dim surf As SldWorks.Surface
267    
268     surf = Me.lst_Faces.Item(0).GetSurface()
269    
270     If surf.IsPlane Then Return True Else Return False
271    
272     End Function
273    
274    
275     ''' <summary>
276     ''' Retourne vrai si la face est un plan mais pas vu comme tel par solidworks.
277     ''' </summary>
278     ''' <param name="x"></param>
279     ''' <param name="y"></param>
280     ''' <param name="z"></param>
281     ''' <returns></returns>
282     ''' <remarks></remarks>
283     Public Function estFauxPlan(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean
284     Dim surf As SldWorks.Surface
285     surf = Me.lst_Faces.Item(0).GetSurface()
286     If Not surf.IsParametric Then Return False
287    
288     ' si la normale est la même au point d'intersection et à quelques sommets, alors on a une face plane.
289     Dim Normale(2) As Double
290     Dim vNormale As Object
291    
292     vNormale = surf.EvaluateAtPoint(x, y, z) ' la normale du point d'intersection
293     Normale(0) = vNormale(0)
294     Normale(1) = vNormale(1)
295     Normale(2) = vNormale(2)
296    
297     Dim i As Integer
298     Dim U As Double, V As Double, Umin As Double, Umax As Double, Vmin As Double, Vmax As Double
299     Dim retval As Object
300    
301     retval = surf.Parameterization()
302     Umin = retval(0)
303     Umax = retval(1)
304     Vmin = retval(2)
305     Vmax = retval(3)
306    
307     Randomize()
308    
309     For i = 0 To 5
310     U = Rnd() * (Umax - Umin) + Umin
311     V = Rnd() * (Vmax - Vmin) + Vmin
312     vNormale = surf.Evaluate(U, V, 0, 0)
313     If Not (Math.Abs(vNormale(3) - Normale(0)) < Epsilon And Math.Abs(vNormale(4) - Normale(1)) < Epsilon And Math.Abs(vNormale(5) - Normale(2)) < Epsilon) Then Return False
314     Next i
315    
316     Return True
317    
318    
319    
320     End Function
321    
322     Public Function estCylindre() As Boolean
323     Dim surf As SldWorks.Surface
324    
325     surf = Me.lst_Faces.Item(0).GetSurface
326    
327     If surf.IsCylinder Then Return True Else Return False
328    
329     End Function
330    
331    
332     Protected Overrides Sub Finalize()
333     ' mettre l'effacement des listes ici.
334    
335     MyBase.Finalize()
336     End Sub
337    
338    
339    
340     Public Sub MettreAttributPourConditionLimite()
341     Dim swent As SldWorks.Entity
342     Dim nom As String
343     Dim cond As String
344    
345     cond = Me.condition
346     If cond = "" Then Exit Sub
347    
348     swent = Me.SwFace
349    
350     nom = Me.nom & "CL" & CStr(no) & "_" & cond
351     Dim Attr As SldWorks.Attribute = Nothing
352    
353     Try
354     Attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
355     Catch ex As Exception
356     MsgBox("N'arrive pas à se lier à l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
357     End Try
358    
359     If Attr Is Nothing Then Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.SwFace, nom, 0, 2) ' 0 = swThisconfig
360    
361    
362     While Attr Is Nothing
363     no += 1
364     nom = "CL" & Me.nom & "_" & cond
365     Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.SwFace, nom, 0, 0)
366     End While
367    
368    
369     Dim ParamCL As SldWorks.Parameter
370     ParamCL = Attr.GetParameter("CL")
371    
372     ParamCL.SetStringValue2(cond, 2, "") ' swAllConfiguration = 2
373     Me.AttributCL = Attr
374     GererDossiers("Conditions Aux Limites", nom)
375     no = no + 1
376    
377     End Sub
378    
379     ' une fonction qui transforme un attribut en condition aux limites
380     Public Sub AttributVersConditionLimite()
381     Dim p As SldWorks.Parameter
382     Dim ent As SldWorks.Entity
383     Dim attr As SldWorks.Attribute
384    
385     ent = Me.SwFace
386     attr = ent.FindAttribute(Intersections.DefAttrConditionLimite, 0)
387     If Not attr Is Nothing Then
388     p = attr.GetParameter("CL")
389     nom = nomOrig & "@" & p.GetStringValue
390     End If
391    
392     End Sub
393    
394    
395     ' sub qui découpe les bords de la face.
396     Friend Sub CoupeCote(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre)
397     Dim pt3() As Double, pt3Original() As Double
398     Dim base(2) As Double, baseOriginal(2) As Double
399     Dim swEnt As SldWorks.Entity
400     Dim Directionnel As Boolean, Flip As Boolean
401     Dim planReference As SldWorks.RefPlane = Nothing
402     Dim sketchline As SldWorks.SketchSegment
403     Dim swSketch As SldWorks.Sketch
404     Dim DemiLargeur As Double
405     Dim g As Integer
406     Dim Face(1) As SldWorks.Face2
407     Dim PlanEntity As SldWorks.Entity = Nothing
408     Dim r(2) As Double
409     Dim sk(1) As Double
410     pt3Original = poutre.GetPoint3
411    
412    
413     swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
414     'swModel.SetAddToDB(True)
415     'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
416    
417     Dim vArete As Object
418     Dim cut As Double
419    
420     If Me.estPlan Then
421     ' la coque est plane, on met une esquisse dessus.#
422     PlanEntity = Me.SwFace
423    
424     ElseIf Me.estCylindre Then
425     ' on doit créer un plan de référence...
426    
427     ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
428     Dim vEdge As Object
429     Dim i As Integer
430     Dim swArete2() As SldWorks.Edge
431     Dim swSommet As SldWorks.Vertex
432    
433     vEdge = Me.SwFace.GetEdges
434     swArete2 = vEdge
435     swModel.ClearSelection2(True)
436    
437     While planReference Is Nothing
438     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
439     swSommet = swArete2(i).GetStartVertex()
440     swEnt = swSommet
441     swEnt.Select4(False, Nothing)
442     swArete2(i + 1).GetStartVertex()
443     swEnt = swSommet
444     swEnt.Select4(True, Nothing)
445     swArete2(i + 2).GetStartVertex()
446     swEnt = swSommet
447     swEnt.Select4(True, Nothing)
448     i += 1
449     planReference = swModel.CreatePlaneThru3Points3(False)
450     PlanEntity = planReference
451     End While
452    
453    
454     Else ' la face est une spline
455     MsgBox("Dans coupeCoté, la face est un type de surface qui n'est pas encore traité")
456     End If
457    
458    
459     baseOriginal(0) = inter.x : baseOriginal(1) = inter.y : baseOriginal(2) = inter.z
460    
461    
462     Dim Psi As Double
463     Dim u(2) As Double, v(2) As Double, usketch(2) As Double, vsketch(2) As Double
464     Dim Arete As SldWorks.Edge = Nothing
465     Dim retval As Object
466     u = poutre.GetOrientation(inter.x, inter.y, inter.z)
467    
468    
469     vArete = Me.SwFace.GetEdges
470    
471     For Each Arete In vArete
472     If Commun.Distance(Arete, inter.x, inter.y, inter.z) < Epsilon Then Exit For
473     Next
474    
475     retval = Arete.GetClosestPointOn(inter.x, inter.y, inter.z)
476     retval = Arete.Evaluate(retval(3))
477     v(0) = retval(3) : v(1) = retval(4) : v(2) = retval(5)
478    
479    
480    
481    
482     For g = 0 To 1
483    
484     PlanEntity.Select(False)
485     swModel.InsertSketch2(True)
486     swSketch = swModel.GetActiveSketch2
487    
488     pt3 = Commun.TransfertModelSketch(swSketch, pt3Original)
489     usketch = Commun.TransfertModelSketch(swSketch, u) ' on les met dans le plan du sketch
490     vsketch = Commun.TransfertModelSketch(swSketch, v)
491     base = Commun.TransfertModelSketch(swSketch, baseOriginal)
492     Psi = Outils_Math.cosdir(usketch, vsketch)
493    
494     Dim a As Double, b As Double
495     'longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
496     'If pt3(1) = 0 Then a = 999999999999 Else a = Math.Abs(poutre.GetD2() * longueur / pt3(1))
497     'If pt3(0) = 0 Then b = 999999999999 Else b = Math.Abs(poutre.GetD1() * longueur / pt3(0))
498     ' À revoir. Si le plan est un cylindre ça marche plus. sans compter l'épaisseur de la poutre.
499     ' pour l'instant je prend la plus prtite valeur...
500     a = poutre.GetD1
501     b = poutre.GetD2
502     DemiLargeur = Math.Min(a, b)
503     cut = DemiLargeur / Math.Sin(Pi / 2 - Psi)
504    
505    
506     Dim P1(1) As Double
507     Dim P2(1) As Double
508     Dim P3(1) As Double
509     Dim P4(1) As Double
510     Dim Ptest(2) As Double
511    
512    
513     If g = 0 Then
514     P1(0) = -cut
515     P1(1) = -cut '* mult ' 0
516     P2(0) = 0
517     P2(1) = -cut '* mult ' 0
518     P3(0) = 0
519     P3(1) = cut 'Intersections.Taille mult
520     P4(0) = -cut
521     P4(1) = cut 'Intersections.Taille mult
522     sk(0) = -Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
523    
524     Else
525     P1(0) = 0
526     P1(1) = -cut '* mult '0
527     P2(0) = +cut
528     P2(1) = -cut '* mult '0
529     P3(0) = +cut
530     P3(1) = cut 'Intersections.Taille mult
531     P4(0) = 0
532     P4(1) = cut 'Intersections.Taille mult
533     sk(0) = Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
534    
535     End If
536    
537     P1 = Outils_Math.Rotation2D(vsketch, P1)
538     P2 = Outils_Math.Rotation2D(vsketch, P2)
539     P3 = Outils_Math.Rotation2D(vsketch, P3)
540     P4 = Outils_Math.Rotation2D(vsketch, P4)
541     sk = Outils_Math.Rotation2D(vsketch, sk)
542    
543     sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P2(0) + base(0), P2(1) + base(1), 0)
544     sketchline = swModel.CreateLine2(P2(0) + base(0), P2(1) + base(1), 0, P3(0) + base(0), P3(1) + base(1), 0)
545     sketchline = swModel.CreateLine2(P3(0) + base(0), P3(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
546     sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
547    
548     swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
549     swModel.ClearSelection2(True)
550     swEnt = Me.SwFace : swEnt.Select2(False, 1)
551     swEnt = swSketch : swEnt.Select2(True, 4)
552    
553     swModel.InsertSplitLineProject(Directionnel, Flip)
554     r = Commun.TransfertSketchToModel(swSketch, sk)
555     Face(g) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference)
556     'If Face(g) Is Nothing Then
557     'swSketch.Select(False)
558     'swModel.EditDelete()
559     'End If
560    
561     Next g
562    
563    
564    
565     ' mettre les mini-poutres
566     Dim vEdge2 As Object
567     Dim swArete As SldWorks.Edge
568     Dim vPoint As Object
569     Dim Mini1 As SldWorks.Edge = Nothing, Mini2 As SldWorks.Edge = Nothing
570    
571    
572     ' 1 - trouver les 2 arrères dont l'orientation est la même (ou l'inverse) que le v
573     For g = 0 To 1
574     If Not Face(g) Is Nothing Then
575     vEdge2 = Face(g).GetEdges()
576    
577    
578     ' construire u
579     For Each swArete In vEdge2
580     If Commun.Distance(swArete, inter.x, inter.y, inter.z) < Epsilon Then
581     ' l'arête touche à l'intersection,
582     vPoint = swArete.GetClosestPointOn(inter.x, inter.y, inter.z)
583     vPoint = swArete.Evaluate(vPoint(3))
584     u(0) = vPoint(3) : u(1) = vPoint(4) : u(2) = vPoint(5)
585    
586     If Outils_Math.CompareSens(v, u) Then
587     ' l'arète doit être une mini-poutre
588     If Mini1 Is Nothing Then Mini1 = swArete : Exit For Else Mini2 = swArete : Exit For
589     End If
590     End If
591    
592     Next
593    
594     End If
595     Next
596    
597     swEnt = Mini1
598     If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
599    
600     If Not Mini2 Is Nothing Then
601     swEnt = Mini2
602     If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
603     End If
604    
605     swModel.SetInferenceMode(True) '
606     'swModel.SetAddToDB(False)
607     'swModel.SetDisplayWhenAdded(True) '
608     End Sub
609    
610    
611     ' sub qui coupe la face avec une arète qui repose dessus.
612     Friend Sub CoupeLong(ByRef inter As InterPoutreVolume, ByVal poutre As SlyAretePoutre)
613     Dim swEnt As SldWorks.Entity
614     Dim swSketchSegment As SldWorks.SketchSegment
615     Dim vSketchSegments As Object
616     Dim swSketch As SldWorks.Sketch
617     Dim faceinterne(1) As SldWorks.Face2
618     Dim swPlan As SldWorks.RefPlane = Nothing
619     Dim b As Integer
620     Dim swSommet As SldWorks.Vertex
621     Dim i As Integer
622    
623     swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
624    
625     ' faut découper toutes les faces de la liste si elles ne sont pas des faces internes
626     Dim MeFace As SldWorks.Face2
627     Dim ListeFace() As SldWorks.Face2
628     ReDim ListeFace(Me.lst_Faces.Count - 1)
629    
630     For i = 1 To Me.lst_Faces.Count
631     ListeFace(i - 1) = Me.lst_Faces.Item(i)
632     Next
633    
634     For Each MeFace In ListeFace
635    
636     If Me.estPlan Then
637     swEnt = MeFace
638     swEnt.Select(False)
639     swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
640     swEnt.Select(False)
641     swModel.InsertSketch2(True)
642    
643     swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
644    
645     ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
646     If b = 0 Then
647     Dim vEdge As Object
648    
649    
650     vEdge = MeFace.GetEdges
651     swModel.ClearSelection2(True)
652     While swPlan Is Nothing
653     If UBound(vEdge) - 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
654     swSommet = vEdge(i).GetStartVertex()
655     swEnt = swSommet
656     swEnt.Select4(False, Nothing)
657     swSommet = vEdge(i + 1).GetStartVertex()
658     swEnt = swSommet
659     swEnt.Select4(True, Nothing)
660     swSommet = vEdge(i + 2).GetStartVertex()
661     swEnt = swSommet
662     swEnt.Select4(True, Nothing)
663     i += 1
664     swPlan = swModel.CreatePlaneThru3Points3(False)
665    
666     End While
667     End If
668     swEnt = swPlan
669     swEnt.Select(False)
670     swModel.InsertSketch2(True)
671    
672     Else
673     MsgBox("Dans coupeLong, on a un type de face qui n'est pas encore traité")
674    
675     End If
676    
677    
678     swSketch = swModel.GetActiveSketch2
679    
680     swEnt = poutre.swArete
681     swEnt.Select(False)
682    
683     ' créer la ligne de «conversion de entités»
684     swModel.SketchUseEdge2(False)
685    
686     vSketchSegments = swSketch.GetSketchSegments()
687     swSketchSegment = vSketchSegments(0)
688     swSketchSegment.Select2(False, 1) 'on sélectionne l'arète de poutre...
689    
690     Dim x As Double, y As Double, z As Double
691     Commun.GetMidPointSegment(swSketchSegment, x, y, z)
692    
693    
694     ' sketchoffset doit avoir un mark de 1 pour l'objet à offsetter. Une valeur négative inverse la direction
695     swModel.SketchManager.SketchOffset(poutre.GetD2, False, 0, 0, 0, 0)
696     ' pour rendre le modèle plus beau, on peut enlever la contrainte de offset et laisser solidworks mettre des contraintes automatiques...
697    
698     Dim retval As Object
699     Dim skPointA1 As SldWorks.SketchPoint = Nothing, skPointA2 As SldWorks.SketchPoint = Nothing, skPointB1 As SldWorks.SketchPoint = Nothing, skPointB2 As SldWorks.SketchPoint = Nothing
700    
701     vSketchSegments = swSketch.GetSketchSegments()
702     swSketchSegment = vSketchSegments(1)
703    
704    
705     Select Case swSketchSegment.GetType()
706     Case 0 ' on a une ligne
707     Dim sketchline As SldWorks.SketchLine
708     sketchline = swSketchSegment
709     skPointA1 = sketchline.GetStartPoint2
710     skPointA2 = sketchline.GetEndPoint2()
711     Case 1 ' arc
712     Dim arc As SldWorks.SketchArc
713     arc = swSketchSegment
714     skPointA1 = arc.GetStartPoint
715     skPointA2 = arc.GetEndPoint2
716     Case 2 ' ellipse
717     Dim sketchEllipse As SldWorks.SketchEllipse
718     sketchEllipse = swSketchSegment
719     skPointA1 = sketchEllipse.GetStartPoint2
720     skPointA2 = sketchEllipse.GetEndPoint2
721     Case 3 ' spline
722     Dim spline As SldWorks.SketchSpline
723     Dim pts() As SldWorks.SketchPoint
724     spline = swSketchSegment
725     retval = spline.GetPoints2()
726     pts = retval
727     skPointA1 = pts(0)
728     skPointA2 = pts(UBound(pts))
729     Case 5 ' parabole (le 4 est du texte)
730     Dim para As SldWorks.SketchParabola
731     para = swSketchSegment
732     skPointA1 = para.GetStartPoint2
733     skPointA2 = para.GetEndPoint2
734     End Select
735    
736     swSketchSegment = vSketchSegments(0)
737     Select Case swSketchSegment.GetType()
738     Case 0 ' on a une ligne
739     Dim sketchline As SldWorks.SketchLine
740     sketchline = swSketchSegment
741     skPointB1 = sketchline.GetStartPoint2
742     skPointB2 = sketchline.GetEndPoint2()
743     Case 1 ' arc
744     Dim arc As SldWorks.SketchArc
745     arc = swSketchSegment
746     skPointB1 = arc.GetStartPoint
747     skPointB2 = arc.GetEndPoint2
748     Case 2 ' ellipse
749     Dim sketchEllipse As SldWorks.SketchEllipse
750     sketchEllipse = swSketchSegment
751     skPointB1 = sketchEllipse.GetStartPoint2
752     skPointB2 = sketchEllipse.GetEndPoint2
753     Case 3 ' spline
754     Dim spline As SldWorks.SketchSpline
755     Dim pts() As SldWorks.SketchPoint
756     spline = swSketchSegment
757     retval = spline.GetPoints2()
758     pts = retval
759     skPointB1 = pts(0)
760     skPointB2 = pts(UBound(pts))
761     Case 5 ' parabole (le 4 est du texte)
762     Dim para As SldWorks.SketchParabola
763     para = swSketchSegment
764     skPointB1 = para.GetStartPoint2
765     skPointB2 = para.GetEndPoint2
766     End Select
767    
768     ' création des 2 lignes pour fermer le sketch.
769     swModel.CreateLine2(skPointA1.X, skPointA1.Y, 0, skPointB1.X, skPointB1.Y, 0)
770     swModel.CreateLine2(skPointA2.X, skPointA2.Y, 0, skPointB2.X, skPointB2.Y, 0)
771    
772    
773     Dim x2 As Double, y2 As Double, z2 As Double ' le midpoint de la poutre
774     Dim x3 As Double, y3 As Double, z3 As Double ' le midpoint de la poutre
775    
776     swSketchSegment = vSketchSegments(0) ' le midpoint d'une poutre
777     Commun.GetMidPointSegment(swSketchSegment, x2, y2, z2)
778    
779     swSketchSegment = vSketchSegments(1) ' le midpoint de l'autre poutre
780     Commun.GetMidPointSegment(swSketchSegment, x3, y3, z3)
781    
782     Dim sk(1) As Double, r(2) As Double
783     sk(0) = (x3 + x2) / 2
784     sk(1) = (y3 + y2) / 2
785     r = Commun.TransfertSketchToModel(swSketch, sk)
786    
787     swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
788     swModel.ClearSelection2(True)
789     swEnt = MeFace : swEnt.Select2(False, 1)
790     swEnt = swSketch : swEnt.Select2(True, 4)
791    
792     swModel.InsertSplitLineProject(False, False)
793    
794     Me.Flag = 20 ' pour dire que l'on a un coupeLong
795     faceinterne(b) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), swPlan) ' et ça s'occupe de créer la coque... mais je suis pas certain que c'est nécessaire
796     Me.Flag = 0
797    
798     'If faceinterne(b) Is Nothing Then
799     'swEnt = swSketch
800     'swEnt.Select(False)
801     'swModel.EditDelete()
802     'End If
803    
804    
805    
806     ' reste à updater, on doit ajouter de 2 à 4 mini-poutres
807     'Dim vEdges As Object
808     'Dim Arete As SldWorks.Edge
809     'Dim vFaces As Object
810     'Dim aretePoutre As SldWorks.Edge
811    
812    
813     ''For b = 0 To 1
814     ''If Not faceinterne(b) Is Nothing Then
815     'b = 0
816     'While faceinterne(b) Is Nothing
817     ' b += 1
818     'End While
819    
820     'vEdges = faceinterne(b).GetEdges
821     'For Each Arete In vEdges
822     ' If Distance(Arete.GetStartVertex, inter.x, inter.y, inter.z) < Epsilon Then swSommet = Arete.GetStartVertex : Exit For
823     ' If Distance(Arete.GetEndVertex, inter.x, inter.y, inter.z) < Epsilon Then swSommet = Arete.GetEndVertex : Exit For
824     'Next
825    
826     'Dim T As Double
827     'Dim xyz(2) As Double
828     'Dim g As Integer
829     'Dim courbe As SldWorks.Curve
830    
831     'T = poutre.GetT(inter.x, inter.y, inter.z)
832    
833     'vEdges = swSommet.GetEdges
834    
835     'T -= 10000 * Epsilon
836    
837     'For g = 0 To UBound(vEdges) ' boucle pas optimisée en vitesse
838     ' Arete = vEdges(g)
839     ' If poutre.Evaluer(T, xyz) Then
840     ' courbe = Arete.GetCurve
841     ' If Distance(courbe, xyz(0), xyz(1), xyz(2)) < Epsilon Then aretePoutre = Arete
842     ' ElseIf poutre.Evaluer(T + 20000 * Epsilon, xyz) Then
843     ' courbe = Arete.GetCurve
844     ' If Distance(courbe, xyz(0), xyz(1), xyz(2)) < Epsilon Then aretePoutre = Arete ' la distance devrait être entre la droite (et non l'arête) et le point.
845     ' End If
846     'Next g
847    
848    
849     'If aretePoutre Is Nothing Then
850     ' ' putain d'enfoiré de merde!!!! on trouve pas la courbe de la poutre. alors on sort avec dignité!
851     ' Exit Sub
852     ' ' anyway on avait dit en réunion de ne pas mettre de minipoutres...
853     'End If
854    
855    
856     '' on a l'arète de la poutre, avec la boucle de la face on prend une arète avant et une arête après.
857     'Dim swBoucle As SldWorks.Loop2
858     'Dim AreteAvant As SldWorks.Edge, AreteSuivant As SldWorks.Edge, areteTest As SldWorks.Edge
859     'Dim varete As Object
860     'Dim Mini1 As SldWorks.Edge, Mini2 As SldWorks.Edge, Mini3 As SldWorks.Edge, Mini4 As SldWorks.Edge
861    
862     'Dim j As Integer
863    
864     'If Not faceinterne(0) Is Nothing Then
865     ' swBoucle = faceinterne(0).GetFirstLoop ' devrait y en avoir juste une...
866     ' varete = swBoucle.GetEdges()
867    
868     ' For j = 0 To UBound(varete)
869     ' areteTest = varete(j)
870     ' If areteTest Is aretePoutre Then
871     ' If j <> 0 Then Mini1 = varete(j - 1) Else Mini1 = varete(UBound(varete))
872     ' If j <> UBound(varete) Then Mini2 = varete(j + 1) Else Mini2 = varete(0)
873     ' End If
874     ' Next j
875     'End If
876    
877     'If Not faceinterne(1) Is Nothing Then
878     ' swBoucle = faceinterne(1).GetFirstLoop ' devrait y en avoir juste une...
879     ' varete = swBoucle.GetEdges()
880    
881     ' For j = 0 To UBound(varete)
882     ' areteTest = varete(j)
883     ' If areteTest Is aretePoutre Then
884     ' If j <> 0 Then Mini3 = varete(j - 1) Else Mini3 = varete(UBound(varete))
885     ' If j <> UBound(varete) Then Mini4 = varete(j + 1) Else Mini4 = varete(0)
886     ' End If
887     ' Next j
888     'End If
889     'If Not Mini1 Is Nothing Then
890     ' swEnt = Mini1
891     ' If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
892     'End If
893    
894     'If Not Mini2 Is Nothing Then
895     ' swEnt = Mini2
896     ' If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
897     'End If
898    
899     'If Not Mini3 Is Nothing Then
900     ' swEnt = Mini3
901     ' If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
902     'End If
903    
904     'If Not Mini4 Is Nothing Then
905     ' swEnt = Mini4
906     ' If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
907     'End If
908     Next MeFace
909    
910    
911     swModel.SetInferenceMode(True) ' ne pas mettre de contraintes par défaut
912     'swModel.SetAddToDB(False)
913     'swModel.SetDisplayWhenAdded(True) ' accélérer les performances
914    
915     End Sub
916    
917    
918     ' sub qui coupe la face normalement, avec un X.... [cas #1]
919     Friend Sub CoupeX(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre)
920    
921     Dim swEnt As SldWorks.Entity = Nothing
922     Dim Directionnel As Boolean, Flip As Boolean
923     Dim Faces(3) As SldWorks.Face2
924     Dim r(2) As Double
925     Dim LaSurface As SldWorks.Surface
926     Dim sens As Boolean
927     Dim p(2) As Double
928     Dim retour() As Double
929    
930     swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
931     'swModel.SetAddToDB(True)
932     'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
933    
934    
935     ' l'idée est de sélectionner le point et l'arète puis d'utiliser CreatePlanePerCurveAndPassPoint3
936     Dim planReference As SldWorks.RefPlane
937     Dim swsketch As SldWorks.Sketch
938     Dim swSommet As SldWorks.Vertex, swSommet2 As SldWorks.Vertex
939     Dim pointdeb(2) As Double, pointfin(2) As Double
940    
941     'swModel.Extension.SelectByID2("", "POINTREF", inter.x, inter.y, inter.z, False, 0, Nothing, 0)
942     ' faut vraiment sélectionner le bon point...
943     swSommet = poutre.swArete.GetStartVertex()
944     swSommet2 = poutre.swArete.GetEndVertex()
945     If swSommet Is Nothing Then
946     MsgBox("On a un cercle ou courbe sans sommets, dans coupeX, pas encore traité. Ne peut pas mettre un plan si pas de sommet")
947     Else
948     If Distance(swSommet, inter.x, inter.y, inter.z) < Epsilon Then
949     swEnt = swSommet
950     ElseIf Distance(swSommet2, inter.x, inter.y, inter.z) < Epsilon Then
951     swEnt = swSommet2
952     Else
953     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")
954     End If
955     End If
956    
957     swEnt.Select4(False, Nothing)
958     swEnt = poutre.swArete
959     swEnt.Select(True)
960    
961     If Me.estPlan Or Me.estFauxPlan(inter.x, inter.y, inter.z) Then
962     ' 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
963     planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
964     Directionnel = False
965     Flip = False
966     ElseIf Me.estCylindre Then
967     ' 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é.
968     Dim PlanDessus As SldWorks.RefPlane
969     Dim Rayon As Double, L As Double, B As Double, phi As Double, dist As Double, temp1 As Double, temp2 As Double
970     Dim u(2) As Double, v(2) As Double
971     PlanDessus = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
972     temp1 = poutre.GetD1
973     temp2 = poutre.GetD2
974     L = Math.Sqrt(temp1 * temp1 + temp2 * temp2)
975     Rayon = Me.GetRayonCylindre()
976     u = poutre.GetOrientation(inter.x, inter.y, inter.z)
977     v = Me.GetNormale(inter.x, inter.y, inter.z)
978     phi = -(Math.Acos(Outils_Math.cosdir(u, v)))
979     B = Math.Abs(L / 2 * Math.Sin(phi))
980     dist = Rayon - Math.Sqrt(Rayon * Rayon - ((L / 2) * (L / 2))) + B
981     If dist < 0 Then MsgBox("Gros problème pour couper le cylindre, la poutre est plus grosse!!!!!!", MsgBoxStyle.Critical) : Exit Sub
982    
983     swEnt = PlanDessus
984     swEnt.Select(False)
985     Directionnel = True
986    
987     Flip = Flipper(PlanDessus, inter)
988    
989     planReference = swModel.CreatePlaneAtOffset3(dist * 2, Flip, True)
990     Else
991     MsgBox("La coque n'est ni un cylindre, ni un plan" & vbCr & "Le résultat n'est pas certain...", MsgBoxStyle.Information, "Avertissement")
992     planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
993     Directionnel = False
994     Flip = False
995     End If
996    
997    
998    
999     LaSurface = Me.SwFace.GetSurface()
1000     sens = Me.SwFace.FaceInSurfaceSense()
1001    
1002     ' 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.
1003     Dim i As Integer, MettreFI As Boolean
1004     Dim swFeat As SldWorks.Feature
1005    
1006     For i = 0 To 1
1007    
1008     swEnt = planReference
1009     swEnt.Select(False)
1010     swModel.InsertSketch2(False)
1011     swModel.ClearSelection2(True)
1012     swFeat = swModel.FeatureByPositionReverse(0)
1013     swModel.SelectByID(swFeat.Name, "SKETCH", 0, 0, 0)
1014     swModel.EditSketch()
1015     swsketch = swModel.GetActiveSketch2
1016    
1017     p(0) = inter.x : p(1) = inter.y : p(2) = inter.z
1018     retour = Commun.TransfertModelSketch(swsketch, p)
1019    
1020    
1021     r = DessineSectionPoutre(poutre, retour(0), retour(1), i + 1, swsketch, inter, MettreFI)
1022     swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
1023     swModel.ClearSelection2(True)
1024    
1025     Dim face As SldWorks.Face2
1026     For Each face In Me.lst_Faces
1027     swModel.ClearSelection2(True)
1028     swEnt = face : swEnt.Select2(False, 1)
1029     swEnt = swsketch : swEnt.Select2(True, 4)
1030     swModel.InsertSplitLineProject(Directionnel, Flip)
1031     Next
1032    
1033    
1034     Me.SwFace.DetachSurface()
1035     Me.SwFace.AttachSurface(LaSurface, sens)
1036    
1037     Faces(i) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, MettreFI)
1038     Commun.MettreUnPoint(r(0), r(1), r(2))
1039    
1040     If Faces(i) Is Nothing Then
1041     swEnt.Select(False)
1042     swModel.EditDelete()
1043     End If
1044     If Flag = 2 Then Flag = 0 : Exit For
1045    
1046     Next i
1047    
1048     swModel.SetInferenceMode(True)
1049     'swModel.SetAddToDB(False)
1050     'swModel.SetDisplayWhenAdded(True)
1051    
1052     End Sub
1053    
1054    
1055     ' Sub qui appelle le découpage de la face
1056     Public Sub decouper()
1057    
1058     If lst_InterPoutre.Count = 0 Then Exit Sub ' sortir si on a pas d'intersection
1059    
1060    
1061     ' les attributs ne sont pas updatés sur les faces (mais sur les arètes et les sommets c'est OK)
1062     ' on mémorise l'attribut de la face et on la réapplique à la fin.
1063    
1064    
1065     Dim i As Integer
1066     Dim inter As InterPoutreVolume
1067     Dim nb1 As Integer, nb2 As Integer, nb3 As Integer, nb5 As Integer
1068     Dim poutre1 As SlyAretePoutre = Nothing, poutre3 As SlyAretePoutre = Nothing
1069     Dim lst_poutre2 As New Collection
1070     Dim aire As Double
1071     Dim poutreTest As SlyAretePoutre
1072    
1073     Dim lst_coupeXinter As New Collection
1074     Dim lst_coupeXPoutre As New Collection
1075     Dim lst_coupeLinter As New Collection
1076     Dim lst_coupeLPoutre As New Collection
1077     Dim lst_coupeCinter As New Collection
1078     Dim lst_coupeCPoutre As New Collection
1079    
1080    
1081     For Each inter In lst_InterPoutre
1082    
1083     'pour chaque intersection on peut avoir plusieurs poutres...
1084     For i = 1 To inter.lst_sPoutre.Count
1085     poutreTest = inter.lst_sPoutre.Item(i)
1086     Select Case CInt(inter.lst_type.Item(i))
1087     Case 1
1088     If poutreTest.GetAireCarree > aire Then poutre1 = poutreTest
1089     nb1 += 1
1090     Case 2
1091     lst_poutre2.Add(poutreTest)
1092     nb2 += 1
1093     Case 3
1094     If poutreTest.GetAireCarree > aire Then poutre3 = poutreTest
1095     nb3 += 1
1096     Case 5 ' un poutre à faceDeSection
1097     nb5 += 1
1098     Case 22
1099     ' on fait rien, mais c'est pour éviter le msgbox du case else...
1100     Case Else
1101     MsgBox("Problème dans découper de SlyFaceCoque, le type d'intersection n'est pas reconnu", MsgBoxStyle.Critical)
1102     End Select
1103     Next i
1104    
1105    
1106    
1107     If nb1 > 0 Then 'CoupeX(inter, poutre1) ' on coupe le x en premier
1108     lst_coupeXinter.Add(inter)
1109     lst_coupeXPoutre.Add(poutre1)
1110     End If
1111    
1112    
1113     For Each poutreTest In lst_poutre2 ' puis on coupe sur la longueur 'CoupeLong(inter, poutreTest)
1114     lst_coupeLinter.Add(inter)
1115     lst_coupeLPoutre.Add(poutreTest)
1116     Next
1117    
1118     If nb3 > 0 Then 'CoupeCote(inter, poutre3) ' finalement on coupe sur les cotés
1119     lst_coupeCinter.Add(inter)
1120     lst_coupeCPoutre.Add(poutre3)
1121     End If
1122    
1123     If nb5 = 1 And (nb1 > 0 Or nb2 > 0 Or nb3 > 0) Then
1124     MsgBox("Problème, on a un type d'intersection impossible dans la vraie vie!", MsgBoxStyle.Exclamation, "Design impossible à obtenir en réalité...")
1125     End If
1126    
1127    
1128     lst_poutre2.Clear()
1129     nb1 = 0 : nb2 = 0 : nb3 = 0
1130    
1131    
1132     Next inter
1133    
1134    
1135     ' maintenant on a toutes les lists d'intersections. On les coupe.
1136     For i = 1 To lst_coupeXinter.Count
1137     CoupeX(lst_coupeXinter.Item(i), lst_coupeXPoutre.Item(i))
1138     Next
1139    
1140     For i = 1 To lst_coupeLinter.Count
1141     CoupeLong(lst_coupeLinter.Item(i), lst_coupeLPoutre.Item(i))
1142     Next
1143    
1144     For i = 1 To lst_coupeCinter.Count
1145     CoupeCote(lst_coupeCinter.Item(i), lst_coupeCPoutre.Item(i))
1146     Next
1147     If nb5 = 1 Then
1148     If lst_InterPoutre.Count <> 1 Then MsgBox("Plus d'une intersection du type FacedeSection....")
1149     CoupeFaceDeSection(lst_InterPoutre(1))
1150     End If
1151    
1152     End Sub
1153    
1154     Private Sub CoupeFaceDeSection(ByRef inter As InterPoutreVolume)
1155     Dim swEnt As SldWorks.Entity = Nothing
1156     Dim Directionnel As Boolean
1157     Dim Faces(3) As SldWorks.Face2
1158     Dim r(2) As Double
1159     Dim p(2) As Double
1160     Dim planReference As SldWorks.RefPlane = Nothing
1161     Dim swsketch As SldWorks.Sketch
1162     Dim pointdeb(2) As Double, pointfin(2) As Double
1163     Dim sketchline As SldWorks.SketchLine
1164     Dim swFeat As SldWorks.Feature
1165    
1166    
1167     swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
1168    
1169     swEnt = Me.SwFace
1170     swEnt.Select(False)
1171     swModel.InsertSketch2(False)
1172     swsketch = swModel.GetActiveSketch2
1173    
1174     ' dessin de la forme à faire...
1175    
1176     Dim xyzc() As Double, xyz(2) As Double
1177     xyz(0) = inter.x : xyz(1) = inter.y : xyz(2) = inter.z
1178     xyzc = Commun.TransfertModelSketch(swsketch, xyz)
1179    
1180     sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) + Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0)
1181     sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) - Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0)
1182     swModel.CreateArc2(xyzc(0), xyzc(1), 0, xyzc(0) + Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0, xyzc(0) - Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0, 1) ' le dernier param est la direction. 1 ou -1
1183    
1184     swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
1185     swModel.ClearSelection2(True)
1186    
1187     swEnt = Me.SwFace : swEnt.Select2(False, 1)
1188     swEnt = swsketch : swEnt.Select2(True, 4)
1189     swModel.InsertSplitLineProject(Directionnel, False)
1190    
1191    
1192     ' flagger les 2 faces comme faces Internes.
1193     Dim vface As Object
1194     Dim face As SldWorks.Face2
1195     Dim attr As SldWorks.Attribute
1196     swFeat = swModel.FeatureByPositionReverse(0)
1197     Try
1198     vface = swFeat.GetFaces
1199     For Each face In vface
1200     '**************
1201     Dim nom2 As String = "FaceInterne" & no
1202     swEnt = face
1203     attr = swEnt.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
1204     If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom2, 0, 2) ' 0 = swThisconfig
1205     While attr Is Nothing
1206     no += 1
1207     nom2 = "FaceInterne" & CStr(no)
1208     attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom2, 0, 2)
1209     End While
1210     GererDossiers("FaceInternes", nom2)
1211     no += 1
1212    
1213    
1214     '**************
1215     Me.AjouterFace(face)
1216     Next face
1217     Catch
1218     ' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
1219     ' on doit donc le déterminer anyway
1220     End Try
1221    
1222     ' si ça ne touche pas à la face
1223     If Not Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
1224     AjouterMiniPoutresSurFaceInterne(inter.lst_sPoutre.Item(1), face, inter.x, inter.y, inter.z)
1225     'MsgBox("On ajoute une mini-poutre entre la poutre " & inter.lst_sPoutre.Item(1).nom & vbCr & " et le point ( " & Format(inter.x * 1000, "0000") & " , " & Format(inter.y * 1000, "0000") & " , " & Format(inter.y * 1000, "0000") & " )")
1226     End If
1227    
1228     swModel.SetInferenceMode(True)
1229    
1230     End Sub
1231    
1232    
1233     Friend Overridable Sub chercherAttributs()
1234     Dim swEnt As SldWorks.Entity
1235     Dim attr As SldWorks.Attribute
1236    
1237     swEnt = Me.SwFace
1238    
1239     attr = swEnt.FindAttribute(Intersections.DefAttrConditionLimite, 0)
1240     If Not attr Is Nothing Then Me.AttributCL = attr : attr = Nothing
1241    
1242     'attr = swent.findattribute(intersections.DefAttrFaceInterne,0) ' ne devrait pas s'entrecouper...
1243    
1244     End Sub
1245    
1246     Private Function Flipper(ByRef PlanDessus As SldWorks.RefPlane, ByRef inter As InterPoutreVolume) As Boolean
1247     ' function qui dit si l'on doit flipper le sens du plan de référence.
1248     ' calcul de la direction à prendre
1249     Dim retval As Object
1250     Dim ret(8) As Double
1251     Dim ret2(6) As Double
1252     Dim normalePlan(2) As Double
1253     Dim OV(2) As Double
1254     Dim swSurf As SldWorks.Surface
1255    
1256     retval = PlanDessus.GetRefPlaneParams()
1257     ret = retval
1258     normalePlan(0) = ret(6) : normalePlan(1) = ret(7) : normalePlan(2) = ret(8)
1259     swSurf = Me.lst_Faces.Item(1).GetSurface
1260     retval = swSurf.CylinderParams() ' 7 doubles, les 3 premiers sont l'origine
1261     ret2 = retval
1262     OV(0) = ret2(0) - inter.x : OV(1) = ret2(1) - inter.y : OV(2) = ret2(2) - inter.z
1263    
1264     ' l'angle est le produit scalaire divisé par la norme des 2 vecteurs
1265     Dim temp As Double = Outils_Math.Angle2Vecteurs(OV, normalePlan)
1266     If (temp < Pi / 2) And (temp > -Pi / 2) Then Return False Else Return True
1267    
1268     End Function
1269    
1270    
1271     Private Function DessineSectionPoutre(ByRef Poutre As SlyAretePoutre, ByVal TranslationX As Double, ByVal TranslationY As Double, ByVal numero As Integer, ByRef swSketch As SldWorks.Sketch, ByRef inter As InterPoutreVolume, ByRef MettreFI As Boolean) As Double()
1272     ' le sketch est déjà inséré, il faut juste mettre des swmodel.line ou autre
1273     ' doit retourner r() qui est un point situé à l'intérieur de la coupe
1274     Dim sketchline As SldWorks.SketchSegment
1275     Dim longueur As Double
1276     Dim r(2) As Double
1277     Dim sk(1) As Double
1278     Dim i As Integer
1279     Dim Ligne() As Double = Nothing ' liste des lignes (4 valeurs par ligne)
1280     Dim pt3() As Double
1281     Dim Nomsection As String
1282    
1283     MettreFI = True
1284    
1285     ' on doit activer le sketch avant d'utiliser la fonction getactivesketch
1286     pt3 = Poutre.GetPoint3
1287     longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
1288     Dim IP(2) As Double ' IP est le vecteur directionnel
1289     IP(0) = pt3(0) - inter.x : IP(1) = pt3(1) - inter.y : IP(2) = pt3(2) - inter.z
1290    
1291    
1292     pt3 = Commun.TransfertModelSketch(swSketch, pt3)
1293     longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
1294    
1295     Nomsection = Poutre.GetNomSection
1296     If Nomsection = "Rectangle" Or Nomsection = " Rectangle générique" Then ' un rectangle
1297     Select Case numero
1298     Case 1
1299     Dim P(2, 1) As Double
1300     P(0, 0) = 0
1301     P(0, 1) = 0
1302     P(1, 0) = Poutre.GetD1 / 2
1303     P(1, 1) = -Poutre.GetD2 / 2
1304     P(2, 0) = Poutre.GetD1 / 2
1305     P(2, 1) = Poutre.GetD2 / 2
1306    
1307     ReDim Ligne(11)
1308     pt3(0) -= TranslationX
1309     pt3(1) -= TranslationY
1310     For i = 0 To 2
1311     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1312     P(i, 0) += TranslationX
1313     P(i, 1) += TranslationY
1314     Next i
1315    
1316     For i = 0 To 1
1317     Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
1318     Next i
1319     Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(0, 0) : Ligne(11) = P(0, 1)
1320    
1321     r(0) = inter.x + 5000 * Epsilon * IP(0)
1322     r(1) = inter.y + 5000 * Epsilon * IP(1)
1323     r(2) = inter.z + 5000 * Epsilon * IP(2)
1324    
1325     Case 2
1326     ReDim Ligne(19)
1327    
1328     Dim p(4, 1) As Double
1329     p(0, 0) = 0
1330     p(0, 1) = 0
1331     p(1, 0) = Poutre.GetD1 / 2
1332     p(1, 1) = Poutre.GetD2 / 2
1333     p(2, 0) = -Poutre.GetD1 / 2
1334     p(2, 1) = Poutre.GetD2 / 2
1335     p(3, 0) = -Poutre.GetD1 / 2
1336     p(3, 1) = -Poutre.GetD2 / 2
1337     p(4, 0) = Poutre.GetD1 / 2
1338     p(4, 1) = -Poutre.GetD2 / 2
1339    
1340    
1341     pt3(0) -= TranslationX
1342     pt3(1) -= TranslationY
1343     pt3(0) /= longueur : pt3(1) /= longueur
1344     For i = 0 To 4
1345     Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
1346     p(i, 0) += TranslationX
1347     p(i, 1) += TranslationY
1348     Next i
1349    
1350     For i = 0 To 3
1351     Ligne(i * 4) = p(i, 0) : Ligne(i * 4 + 1) = p(i, 1) : Ligne(i * 4 + 2) = p(i + 1, 0) : Ligne(i * 4 + 3) = p(i + 1, 1)
1352     Next i
1353     Ligne(16) = p(4, 0) : Ligne(17) = p(4, 1) : Ligne(18) = p(0, 0) : Ligne(19) = p(0, 1)
1354     r(0) = inter.x - 5000 * Epsilon * IP(0)
1355     r(1) = inter.y - 5000 * Epsilon * IP(1)
1356     r(2) = inter.z - 5000 * Epsilon * IP(2)
1357    
1358     End Select
1359     MettreFI = True
1360     ElseIf Left(Nomsection, 2) = "ST" Or Nomsection = " Tube carré générique" Then ' tube carré troué
1361     Dim P(3, 1) As Double
1362     Select Case numero
1363     Case 1
1364     P(0, 0) = Poutre.GetD1 / 2
1365     P(0, 1) = -Poutre.GetD2 / 2
1366     P(1, 0) = P(0, 0)
1367     P(1, 1) = -P(0, 1)
1368     P(2, 0) = -P(0, 0)
1369     P(2, 1) = P(1, 1)
1370     P(3, 0) = P(2, 0)
1371     P(3, 1) = P(0, 1)
1372    
1373     r(0) = P(0, 0) - 1000 * Epsilon
1374     r(1) = 0 : r(2) = 0
1375     Outils_Math.Rotation2D(pt3, r(0), r(1))
1376     r(0) += TranslationX
1377     r(1) += TranslationY
1378     r = Commun.TransfertSketchToModel(swSketch, r)
1379    
1380     pt3(0) -= TranslationX
1381     pt3(1) -= TranslationY
1382     pt3(0) /= longueur : pt3(1) /= longueur
1383     For i = 0 To 3
1384     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1385     P(i, 0) += TranslationX
1386     P(i, 1) += TranslationY
1387     Next i
1388    
1389     ReDim Ligne(15)
1390     Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1391     Ligne(4) = P(1, 0) : Ligne(5) = P(1, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1392     Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(3, 0) : Ligne(11) = P(3, 1)
1393     Ligne(12) = P(3, 0) : Ligne(13) = P(3, 1) : Ligne(14) = P(0, 0) : Ligne(15) = P(0, 1)
1394     MettreFI = False
1395    
1396     Case 2
1397     P(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
1398     P(0, 1) = -Poutre.GetD2 / 2 + Poutre.GetD3
1399     P(1, 0) = P(0, 0)
1400     P(1, 1) = -P(0, 1)
1401     P(2, 0) = -P(1, 0)
1402     P(2, 1) = P(1, 1)
1403     P(3, 0) = P(2, 0)
1404     P(3, 1) = P(0, 1)
1405    
1406     r(0) = P(0, 0) + 1000 * Epsilon
1407     r(1) = 0 : r(2) = 0
1408     Outils_Math.Rotation2D(pt3, r(0), r(1))
1409     r(0) += TranslationX
1410     r(1) += TranslationY
1411     r = Commun.TransfertSketchToModel(swSketch, r)
1412    
1413     pt3(0) -= TranslationX
1414     pt3(1) -= TranslationY
1415     pt3(0) /= longueur : pt3(1) /= longueur
1416     For i = 0 To 3
1417     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1418     P(i, 0) += TranslationX
1419     P(i, 1) += TranslationY
1420     Next i
1421    
1422     ReDim Ligne(15)
1423     Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1424     Ligne(4) = P(1, 0) : Ligne(5) = P(1, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1425     Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(3, 0) : Ligne(11) = P(3, 1)
1426     Ligne(12) = P(3, 0) : Ligne(13) = P(3, 1) : Ligne(14) = P(0, 0) : Ligne(15) = P(0, 1)
1427    
1428     MettreFI = True ' lorsque l'on sort on met une face interne
1429    
1430     End Select
1431    
1432    
1433     ElseIf Left(Nomsection, 1) = "S" Or Nomsection = " Poutre en I générique" Then ' poutre en I de type S
1434     Dim P(8, 1) As Double
1435    
1436     Select Case numero
1437     Case 1
1438     Dim d As Double
1439     d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
1440    
1441     P(0, 0) = 0
1442     P(0, 1) = 0
1443     P(1, 0) = -d
1444     P(1, 1) = -Poutre.GetD4 / 2.0R
1445     P(2, 0) = (Poutre.GetD1 / 2) - Poutre.GetD3
1446     P(2, 1) = -Poutre.GetD4 / 2.0R
1447     P(3, 0) = P(2, 0)
1448     P(3, 1) = -Poutre.GetD2 / 2
1449     P(4, 0) = Poutre.GetD1 / 2
1450     P(4, 1) = P(3, 1)
1451     P(5, 0) = P(4, 0)
1452     P(5, 1) = -P(4, 1)
1453     P(6, 0) = P(3, 0)
1454     P(6, 1) = -P(3, 1)
1455     P(7, 0) = P(2, 0)
1456     P(7, 1) = -P(2, 1)
1457     P(8, 0) = P(1, 0)
1458     P(8, 1) = -P(1, 1)
1459    
1460     pt3(0) -= TranslationX
1461     pt3(1) -= TranslationY
1462     pt3(0) /= longueur : pt3(1) /= longueur
1463     For i = 0 To 8
1464     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1465     P(i, 0) += TranslationX
1466     P(i, 1) += TranslationY
1467     Next i
1468    
1469     ReDim Ligne(35)
1470     For i = 0 To 7
1471     Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
1472     Next i
1473     Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
1474     r(0) = inter.x + 5000 * Epsilon * IP(0)
1475     r(1) = inter.y + 5000 * Epsilon * IP(1)
1476     r(2) = inter.z + 5000 * Epsilon * IP(2)
1477     Case 2
1478    
1479     Dim d As Double
1480     d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
1481    
1482     P(0, 0) = 0
1483     P(0, 1) = 0
1484    
1485     P(1, 0) = -d
1486     P(1, 1) = -Poutre.GetD4 / 2.0R
1487     P(2, 0) = -((Poutre.GetD1 / 2) - Poutre.GetD3)
1488     P(2, 1) = -Poutre.GetD4 / 2.0R
1489     P(3, 0) = P(2, 0)
1490     P(3, 1) = -Poutre.GetD2 / 2
1491     P(4, 0) = -Poutre.GetD1 / 2
1492     P(4, 1) = P(3, 1)
1493     P(5, 0) = P(4, 0)
1494     P(5, 1) = -P(4, 1)
1495     P(6, 0) = P(3, 0)
1496     P(6, 1) = -P(3, 1)
1497     P(7, 0) = P(2, 0)
1498     P(7, 1) = -P(2, 1)
1499     P(8, 0) = P(1, 0)
1500     P(8, 1) = -P(1, 1)
1501    
1502     pt3(0) -= TranslationX
1503     pt3(1) -= TranslationY
1504     pt3(0) /= longueur : pt3(1) /= longueur
1505     For i = 0 To 8
1506     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1507     P(i, 0) += TranslationX
1508     P(i, 1) += TranslationY
1509     Next i
1510    
1511     ReDim Ligne(35)
1512     For i = 0 To 7
1513     Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
1514     Next i
1515     Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
1516    
1517     r(0) = inter.x - 5000 * Epsilon * IP(0)
1518     r(1) = inter.y - 5000 * Epsilon * IP(1)
1519     r(2) = inter.z - 5000 * Epsilon * IP(2)
1520    
1521     End Select
1522     MettreFI = True
1523    
1524     ElseIf Left(Nomsection, 4) = "Tube" Or Nomsection = " Tuyau (Pipe) générique" Then ' le tube rond
1525     Dim p(4, 1) As Double
1526     p(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
1527     p(0, 1) = 0
1528     p(1, 0) = Poutre.GetD1 / 2
1529     p(1, 1) = 0
1530     p(2, 0) = -p(0, 0)
1531     p(2, 1) = 0
1532     p(3, 0) = -p(1, 0)
1533     p(3, 1) = 0
1534     p(4, 0) = 0
1535     p(4, 1) = 0
1536    
1537     Select Case numero
1538     Case 1
1539    
1540     r(0) = 0
1541     r(1) = Poutre.GetD1 / 2 - Poutre.GetD3 / 2 : r(2) = 0
1542     Outils_Math.Rotation2D(pt3, r(0), r(1))
1543     r(0) += TranslationX
1544     r(1) += TranslationY
1545     r = Commun.TransfertSketchToModel(swSketch, r)
1546    
1547     pt3(0) -= TranslationX
1548     pt3(1) -= TranslationY
1549     pt3(0) /= longueur : pt3(1) /= longueur
1550     For i = 0 To 4
1551     Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
1552     p(i, 0) += TranslationX
1553     p(i, 1) += TranslationY
1554     Next i
1555    
1556     ReDim Ligne(7)
1557     Ligne(0) = p(0, 0) : Ligne(1) = p(0, 1) : Ligne(2) = p(1, 0) : Ligne(3) = p(1, 1)
1558     Ligne(4) = p(2, 0) : Ligne(5) = p(2, 1) : Ligne(6) = p(3, 0) : Ligne(7) = p(3, 1)
1559     swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(1, 0), p(1, 1), 0, p(3, 0), p(3, 1), 0, 1)
1560     swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(0, 0), p(0, 1), 0, p(2, 0), p(2, 1), 0, 1)
1561     MettreFI = True
1562     'Flag = 2
1563     Case 2
1564    
1565     r(0) = 0
1566     r(1) = -Poutre.GetD1 / 2 + Poutre.GetD3 / 2 : r(2) = 0
1567     Outils_Math.Rotation2D(pt3, r(0), r(1))
1568     r(0) += TranslationX
1569     r(1) += TranslationY
1570     r = Commun.TransfertSketchToModel(swSketch, r)
1571    
1572     pt3(0) -= TranslationX
1573     pt3(1) -= TranslationY
1574     pt3(0) /= longueur : pt3(1) /= longueur
1575     For i = 0 To 4
1576     Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
1577     p(i, 0) += TranslationX
1578     p(i, 1) += TranslationY
1579     Next i
1580    
1581     ReDim Ligne(7)
1582     Ligne(0) = p(0, 0) : Ligne(1) = p(0, 1) : Ligne(2) = p(1, 0) : Ligne(3) = p(1, 1)
1583     Ligne(4) = p(2, 0) : Ligne(5) = p(2, 1) : Ligne(6) = p(3, 0) : Ligne(7) = p(3, 1)
1584     swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(1, 0), p(1, 1), 0, p(3, 0), p(3, 1), 0, -1)
1585     swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(0, 0), p(0, 1), 0, p(2, 0), p(2, 1), 0, -1)
1586     'MettreFI = True ' lorsque l'on sort on met une face interne
1587     MettreFI = False
1588     Me.Flag = 2
1589     'Case 1 ' le cercle extérieur
1590     ' swModel.CreateCircleByRadius2(TranslationX, TranslationY, 0, Poutre.GetD1 / 2)
1591     ' MettreFI = False
1592     ' r(0) = 0 : r(1) = 0 : r(2) = 0
1593     ' r = Commun.TransfertSketchToModel(swSketch, r)
1594     'Case 2
1595     ' swModel.CreateCircleByRadius2(TranslationX, TranslationY, 0, (Poutre.GetD1 / 2) - Poutre.GetD3)
1596     ' r(0) = (Poutre.GetD1 / 2 - (Poutre.GetD3 / 2))
1597     ' r(1) = 0 : r(2) = 0
1598     ' r = Commun.TransfertSketchToModel(swSketch, r)
1599     ' MettreFI = True
1600     End Select
1601    
1602     ElseIf Left(Nomsection, 1) = "C" Or Nomsection = " Poutre en C générique" Then ' le channel
1603     Dim P(7, 1) As Double
1604    
1605     Select Case numero
1606     Case 1 ' le C au complet
1607    
1608     P(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
1609     P(0, 1) = Poutre.GetD5
1610     P(1, 0) = P(0, 0)
1611     P(1, 1) = Poutre.GetD5 + Poutre.GetD4 - Poutre.GetD2
1612     P(2, 0) = Poutre.GetD1 / 2
1613     P(2, 1) = P(1, 1)
1614     P(3, 0) = P(2, 0)
1615     P(3, 1) = P(1, 1) + Poutre.GetD2
1616     P(4, 0) = -P(3, 0)
1617     P(4, 1) = P(3, 1)
1618     P(5, 0) = P(4, 0)
1619     P(5, 1) = P(1, 1)
1620     P(6, 0) = -P(1, 0)
1621     P(6, 1) = P(5, 1)
1622     P(7, 0) = -P(0, 0)
1623     P(7, 1) = P(0, 1)
1624    
1625     r(0) = P(0, 0) + 1000 * Epsilon
1626     r(1) = 0 : r(2) = 0
1627     Outils_Math.Rotation2D(pt3, r(0), r(1))
1628     r(0) += TranslationX
1629     r(1) += TranslationY
1630     r = Commun.TransfertSketchToModel(swSketch, r)
1631    
1632     pt3(0) -= TranslationX
1633     pt3(1) -= TranslationY
1634     pt3(0) /= longueur : pt3(1) /= longueur
1635     For i = 0 To 7
1636     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1637     P(i, 0) += TranslationX
1638     P(i, 1) += TranslationY
1639     Next i
1640    
1641     ReDim Ligne(35)
1642     For i = 0 To 6
1643     Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
1644     Next i
1645     Ligne(28) = P(7, 0) : Ligne(29) = P(7, 1) : Ligne(30) = P(0, 0) : Ligne(31) = P(0, 1)
1646    
1647     MettreFI = False
1648     Me.Flag = 2
1649     Case 2
1650     MettreFI = False ' Attention, peut planter à cause de ça.
1651     End Select
1652    
1653     ElseIf Left(Nomsection, 1) = "L" Or Nomsection = " Poutre en L générique" Then ' l'Angle en L
1654     Dim P(5, 1) As Double
1655    
1656     Select Case numero
1657     Case 1 ' le C au complet
1658    
1659     P(0, 0) = -Poutre.GetD5 + Poutre.GetD1
1660     P(0, 1) = -Poutre.GetD6 + Poutre.GetD4
1661     P(1, 0) = -Poutre.GetD5 + Poutre.GetD3
1662     P(1, 1) = P(0, 1)
1663     P(2, 0) = P(1, 0)
1664     P(2, 1) = -Poutre.GetD6 + Poutre.GetD2
1665     P(3, 0) = -Poutre.GetD5
1666     P(3, 1) = P(2, 1)
1667     P(4, 0) = P(3, 0)
1668     P(4, 1) = -Poutre.GetD6
1669     P(5, 0) = P(0, 0)
1670     P(5, 1) = P(4, 1)
1671    
1672     r(0) = P(1, 0) - 1000 * Epsilon
1673     r(1) = 0 : r(2) = 0
1674     Outils_Math.Rotation2D(pt3, r(0), r(1))
1675     r(0) += TranslationX
1676     r(1) += TranslationY
1677     r = Commun.TransfertSketchToModel(swSketch, r)
1678    
1679     pt3(0) -= TranslationX
1680     pt3(1) -= TranslationY
1681     pt3(0) /= longueur : pt3(1) /= longueur
1682     For i = 0 To 5
1683     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1684     P(i, 0) += TranslationX
1685     P(i, 1) += TranslationY
1686     Next i
1687    
1688     ReDim Ligne(35)
1689     For i = 0 To 4
1690     Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
1691     Next i
1692     Ligne(20) = P(5, 0) : Ligne(21) = P(5, 1) : Ligne(22) = P(0, 0) : Ligne(23) = P(0, 1)
1693    
1694     MettreFI = False ' lorsque l'on sort on met une face interne
1695     Me.Flag = 2
1696     Case 2
1697     MettreFI = False ' Attention, peut planter à cause de ça.
1698     End Select
1699    
1700    
1701     ElseIf Left(Nomsection, 1) = "T" Or Nomsection = " Poutre en T générique" Then ' le T
1702     Select Case numero
1703     Case 1
1704     Dim P(8, 1) As Double
1705     Dim d As Double
1706     d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
1707    
1708    
1709     P(0, 0) = 0
1710     P(0, 1) = 0
1711     P(1, 0) = -d
1712     P(1, 1) = -Poutre.GetD4 / 2.0R
1713     P(2, 0) = -(Poutre.GetD1 - Poutre.GetD5 - Poutre.GetD3)
1714     P(2, 1) = -Poutre.GetD4 / 2.0R
1715     P(3, 0) = P(2, 0)
1716     P(3, 1) = -Poutre.GetD2 / 2
1717     P(4, 0) = -Poutre.GetD1 + Poutre.GetD5
1718     P(4, 1) = P(3, 1)
1719     P(5, 0) = P(4, 0)
1720     P(5, 1) = -P(4, 1)
1721     P(6, 0) = P(3, 0)
1722     P(6, 1) = -P(3, 1)
1723     P(7, 0) = P(2, 0)
1724     P(7, 1) = -P(2, 1)
1725     P(8, 0) = P(1, 0)
1726     P(8, 1) = -P(1, 1)
1727    
1728     r(0) = P(0, 0) + 1000 * Epsilon
1729     r(1) = 0 : r(2) = 0
1730     Outils_Math.Rotation2D(pt3, r(0), r(1))
1731     r(0) += TranslationX
1732     r(1) += TranslationY
1733     r = Commun.TransfertSketchToModel(swSketch, r)
1734    
1735     pt3(0) -= TranslationX
1736     pt3(1) -= TranslationY
1737     pt3(0) /= longueur : pt3(1) /= longueur
1738     For i = 0 To 8
1739     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1740     P(i, 0) += TranslationX
1741     P(i, 1) += TranslationY
1742     Next i
1743    
1744     ReDim Ligne(35)
1745     For i = 0 To 7
1746     Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
1747     Next i
1748     Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
1749    
1750     Case 2
1751     Dim P(4, 1) As Double
1752     Dim d As Double
1753     d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
1754    
1755     P(0, 0) = 0
1756     P(0, 1) = 0
1757    
1758     P(1, 0) = -d
1759     P(1, 1) = -Poutre.GetD4 / 2.0R
1760     P(2, 0) = Poutre.GetD5
1761     P(2, 1) = -Poutre.GetD4 / 2.0R
1762     P(3, 0) = P(2, 0)
1763     P(3, 1) = Poutre.GetD4 / 2
1764     P(4, 0) = P(1, 0)
1765     P(4, 1) = P(3, 1)
1766    
1767     r(0) = P(0, 0) - 1000 * Epsilon
1768     r(1) = 0 : r(2) = 0
1769     Outils_Math.Rotation2D(pt3, r(0), r(1))
1770     r(0) += TranslationX
1771     r(1) += TranslationY
1772     r = Commun.TransfertSketchToModel(swSketch, r)
1773    
1774     pt3(0) -= TranslationX
1775     pt3(1) -= TranslationY
1776     pt3(0) /= longueur : pt3(1) /= longueur
1777     For i = 0 To 4
1778     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1779     P(i, 0) += TranslationX
1780     P(i, 1) += TranslationY
1781     Next i
1782    
1783     ReDim Ligne(19)
1784     For i = 0 To 3
1785     Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
1786     Next i
1787     Ligne(16) = P(4, 0) : Ligne(17) = P(4, 1) : Ligne(18) = P(0, 0) : Ligne(19) = P(0, 1)
1788    
1789     End Select
1790     MettreFI = True
1791    
1792     ElseIf Left(Poutre.GetNomSection, 1) = "P" Or Nomsection = " Circulaire pleine générique" Then ' Pipe,
1793     Dim P(2, 1) As Double
1794     Dim d As Double, e As Double
1795     d = Poutre.GetD1 / 4 ' Math.Sin(30) ( et on doit diviser le diamètre par 2)
1796     e = Poutre.GetD1 * Math.Sqrt(3) / 4 ' cos (30°)
1797    
1798     P(0, 0) = 0
1799     P(0, 1) = 0
1800     P(1, 0) = d
1801     P(1, 1) = -e
1802     P(2, 0) = d
1803     P(2, 1) = e
1804    
1805     Select Case numero
1806     Case 1
1807     r(0) = P(0, 0) + 1000 * Epsilon
1808     r(1) = 0 : r(2) = 0
1809     Outils_Math.Rotation2D(pt3, r(0), r(1))
1810     r(0) += TranslationX
1811     r(1) += TranslationY
1812     r = Commun.TransfertSketchToModel(swSketch, r)
1813     pt3(0) -= TranslationX
1814     pt3(1) -= TranslationY
1815     pt3(0) /= longueur : pt3(1) /= longueur
1816     For i = 0 To 2
1817     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1818     P(i, 0) += TranslationX
1819     P(i, 1) += TranslationY
1820     Next i
1821     ReDim Ligne(7)
1822     Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1823     Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1824     swModel.CreateArc2(P(0, 0), P(0, 1), 0, P(1, 0), P(1, 1), 0, P(2, 0), P(2, 1), 0, 1) ' le dernier param est la direction. 1 ou -1
1825    
1826     Case 2
1827     r(0) = P(0, 0) - 1000 * Epsilon
1828     r(1) = 0 : r(2) = 0
1829     Outils_Math.Rotation2D(pt3, r(0), r(1))
1830     r(0) += TranslationX
1831     r(1) += TranslationY
1832     r = Commun.TransfertSketchToModel(swSketch, r)
1833    
1834     pt3(0) -= TranslationX
1835     pt3(1) -= TranslationY
1836     pt3(0) /= longueur : pt3(1) /= longueur
1837     For i = 0 To 2
1838     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1839     P(i, 0) += TranslationX
1840     P(i, 1) += TranslationY
1841     Next i
1842     ReDim Ligne(7)
1843     Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1844     Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1845    
1846     swModel.CreateArc2(P(0, 0), P(0, 1), 0, P(1, 0), P(1, 1), 0, P(2, 0), P(2, 1), 0, -1) ' le dernier param est la direction. 1 ou -1
1847    
1848     End Select
1849     MettreFI = True
1850    
1851     Else
1852     MsgBox("Section de poutre non reconnu!", MsgBoxStyle.Critical, "Commun.DessineSectionPoutre")
1853     End If
1854    
1855    
1856     If Not Ligne Is Nothing Then
1857     For i = 0 To UBound(Ligne) Step 4
1858     sketchline = swModel.CreateLine2(Ligne(i), Ligne(i + 1), 0, Ligne(i + 2), Ligne(i + 3), 0)
1859     Next i
1860     End If
1861    
1862     Return r
1863    
1864     End Function
1865    
1866     Public Function SwFace() As SldWorks.Face2 ' retourne la première face de la liste (dans la partie traitement, ce sera la seule...)
1867     Return Me.lst_Faces.Item(0)
1868     End Function
1869    
1870     Public Function IsFaceInterne(ByRef swface As SldWorks.Face2) As Boolean
1871     Dim attr As SldWorks.Attribute
1872     Dim SwEnt As SldWorks.Entity
1873     SwEnt = swface
1874     attr = SwEnt.FindAttribute(DefAttrFaceInterne, 0)
1875     If attr Is Nothing Then Return False Else Return True
1876     End Function
1877    
1878     ''' <summary>
1879     ''' Fonction qui retourne un tableau de Sldworks.edge (et non slyedges)
1880     ''' </summary>
1881     ''' <returns>Un tableau de Edges</returns>
1882     ''' <remarks></remarks>
1883     Public Function GetAretes() As SldWorks.Edge()
1884     Dim face As SldWorks.Face2
1885     Dim arete As SldWorks.Edge = Nothing
1886     Dim temp2 As Collections.Generic.List(Of SldWorks.Edge)
1887     Dim lst As New Collections.Generic.List(Of SldWorks.Edge)
1888    
1889     For Each face In Me.lst_Faces
1890     temp2 = GetArete1Face(face)
1891     For Each arete In temp2
1892     lst.Add(arete)
1893     Next arete
1894     Next face
1895    
1896     Return lst.ToArray
1897     End Function
1898    
1899     Private Function GetArete1Face(ByRef Face As SldWorks.Face2) As Collections.Generic.List(Of SldWorks.Edge)
1900     Dim vArete As Object
1901     Dim a As SldWorks.Edge
1902     Dim arete() As SldWorks.Edge
1903     Dim lst As New Collections.Generic.List(Of SldWorks.Edge)
1904    
1905     ReDim arete(Face.GetEdgeCount - 1)
1906     vArete = Face.GetEdges()
1907    
1908     For Each a In vArete
1909     lst.Add(a)
1910     Next
1911    
1912     Return lst
1913     End Function
1914    
1915     Public Overrides Sub Selectionner(Optional ByVal Mark As Integer = 0, Optional ByRef append As Boolean = True)
1916     Dim swent As SldWorks.Entity
1917     Dim swface As SldWorks.Face2
1918    
1919     For Each swface In lst_Faces
1920     swent = swface
1921     swent.Select2(append, Mark)
1922     Next swface
1923     End Sub
1924    
1925    
1926     ''' <summary>
1927     ''' Sélectionne toutes les faces dans la liste de faces
1928     ''' </summary>
1929     ''' <param name="Mark"></param>
1930     ''' <param name="Append"></param>
1931     ''' <remarks></remarks>
1932     Public Sub SelectionnerToutes(Optional ByRef Mark As Integer = 0, Optional ByRef Append As Boolean = True)
1933     Dim swFace As SldWorks.Face2
1934    
1935     Dim swent As SldWorks.Entity
1936     If Append = False Then swModel.ClearSelection2(True)
1937     For Each swFace In Me.lst_Faces
1938     swent = swFace : swent.Select2(True, Mark)
1939     Next
1940    
1941     End Sub
1942    
1943    
1944    
1945     Public Function Couleur(ByRef rouge As Double, ByRef Vert As Double, ByRef Bleu As Double, Optional ByVal Ambient As Double = 1, Optional ByVal Diffuse As Double = 1, Optional ByVal Specular As Double = 1, Optional ByVal Shininess As Double = 0.5, Optional ByVal Transparency As Double = 0, Optional ByVal Emission As Double = 0.2) As Integer
1946    
1947     swModel.SelectedFaceProperties(RGB(rouge, Vert, Bleu), Ambient, Diffuse, Specular, Shininess, Transparency, Emission, False, "")
1948    
1949     Return 1
1950     End Function
1951    
1952     Public Sub AjouterFace(ByRef face As SldWorks.Face2)
1953     Dim testface As SldWorks.Face2
1954     Dim faultentity As SldWorks.FaultEntity
1955     Dim swent As SldWorks.Entity
1956    
1957     If Not Me.lst_Faces.Contains(face) Then Me.lst_Faces.Add(face)
1958    
1959     ' vérifier que les anciennes faces sont toujours ok...
1960     For Each testface In Me.lst_Faces
1961     faultentity = testface.Check
1962     If Not faultentity.Count = 0 Then ' on a un problème avec la face....
1963     lst_Faces.Remove(testface)
1964     Dim i As Integer
1965     For i = 0 To faultentity.Count
1966     swent = faultentity.Entity(i)
1967     If Not swent Is Nothing Then
1968     swent.Select4(True, Nothing)
1969     End If
1970     Debug.Print(" Fault[" & i & "] = " & swent.errorCode(i))
1971     Next i
1972     End If
1973     Next testface
1974    
1975    
1976     End Sub
1977    
1978    
1979     'Public Function DonnerFaces() As SldWorks.Face2()
1980     ' 'Dim temp() As SldWorks.Face2
1981     ' 'Dim i As Integer
1982    
1983     ' 'ReDim temp(lst_Faces.Count - 1)
1984    
1985     ' 'For i = 1 To lst_Faces.Count
1986     ' ' temp(i - 1) = lst_Faces.Item(i)
1987     ' 'Next
1988    
1989     ' Return lst_Faces.ToArray
1990     'End Function
1991    
1992    
1993    
1994     ''' <summary>
1995     ''' Function qui retourne un pointeur vers la face
1996     ''' </summary>
1997     ''' <returns></returns>
1998     ''' <remarks></remarks>
1999     Public Function GetFace() As SldWorks.Face2
2000     Return Me.SwFace
2001     End Function
2002    
2003     ''' <summary>
2004     ''' Fonction qui redonne toutes les Faces contenues dans cette face
2005     ''' </summary>
2006     ''' <returns></returns>
2007     ''' <remarks></remarks>
2008     Public Function GetFaces() As SldWorks.Face2()
2009     Return Me.lst_Faces.ToArray
2010     End Function
2011    
2012     ''' <summary>
2013     ''' Sub qui renvoie les coordonnées min et max des valeurs U et V
2014     ''' </summary>
2015     ''' <param name="Umin"></param>
2016     ''' <param name="UMax"></param>
2017     ''' <param name="VMin"></param>
2018     ''' <param name="VMax"></param>
2019     ''' <remarks></remarks>
2020     Public Sub UVMinMax(ByRef Umin As Double, ByRef UMax As Double, ByRef VMin As Double, ByRef VMax As Double)
2021     Dim vBounds As Object
2022     vBounds = SwFace.GetUVBounds()
2023    
2024     Umin = vBounds(0)
2025     UMax = vBounds(1)
2026    
2027     VMin = vBounds(2)
2028     VMax = vBounds(3)
2029     End Sub
2030    
2031     ''' <summary>
2032     ''' Calcule la position du point selon les U et V
2033     ''' </summary>
2034     ''' <param name="U"></param>
2035     ''' <param name="V"></param>
2036     ''' <param name="X"></param>
2037     ''' <param name="Y"></param>
2038     ''' <param name="Z"></param>
2039     ''' <returns>Vrai si l epoint est sur la face, faux sinon</returns>
2040     ''' <remarks>Retourne X, Y et Z même si le point n'est pas sur la face (mais sur la surface) </remarks>
2041     Public Function Evaluer(ByRef U As Double, ByVal V As Double, ByRef X As Double, ByRef Y As Double, ByRef Z As Double) As Boolean
2042     Dim surf As SldWorks.Surface
2043     Dim vEv As Object, vpoint As Object
2044     Dim P(2) As Double
2045    
2046     surf = SwFace.GetSurface()
2047    
2048     vEv = surf.Evaluate(U, V, 0, 0)
2049    
2050     X = vEv(0) : Y = vEv(1) : Z = vEv(2)
2051    
2052     vpoint = SwFace.GetClosestPointOn(X, Y, Z)
2053    
2054     If (Math.Abs(vpoint(0) - X) < Epsilon) And (Math.Abs(vpoint(1) - Y) < Epsilon) And (Math.Abs(vpoint(2) - Z) < Epsilon) Then Return True Else Return False
2055    
2056     End Function
2057    
2058     ''' <summary>
2059     ''' Function qui calcule la normale d'une face au point X,Y,Z.
2060     ''' </summary>
2061     ''' <param name="X"></param>
2062     ''' <param name="Y"></param>
2063     ''' <param name="Z"></param>
2064     ''' <returns>Un tableau de 3 doubles correspondant à la normale</returns>
2065     ''' <remarks></remarks>
2066     Public Function Normale(ByRef X As Double, ByRef Y As Double, ByRef Z As Double) As Double()
2067     Dim surf As SldWorks.Surface
2068     Dim vtemp As Object
2069     Dim temp() As Double
2070     Dim sens As Boolean
2071    
2072     surf = SwFace.GetSurface
2073     If surf.IsPlane Then vtemp = SwFace.Normal : temp = vtemp : Return temp ' si la face est plane alors c'est ok, sinon il faut travailler...
2074    
2075    
2076     vtemp = surf.EvaluateAtPoint(X, Y, Z)
2077     ReDim temp(2)
2078    
2079     ' la normale de la face pointe AWAY from the body
2080    
2081     sens = SwFace.FaceInSurfaceSense() 'TRUE if face normal and surface normal are in the opposite direction and FALSE if they are in the same direction
2082    
2083    
2084     If sens Then ' on doit inverser
2085     temp(0) = -vtemp(0) : temp(1) = -vtemp(1) : temp(2) = -vtemp(2)
2086     Else
2087     temp(0) = vtemp(0) : temp(1) = vtemp(1) : temp(2) = vtemp(2)
2088     End If
2089     Return temp
2090    
2091     End Function
2092    
2093    
2094     Public Sub MettreAttributFaceInterne(Optional ByRef Valeur As Double = 0)
2095     Dim no As Integer = 0
2096     Dim nom As String = "FaceInterne" & no
2097     Dim swent As SldWorks.Entity
2098     Dim attr As SldWorks.Attribute
2099    
2100     swent = Me.SwFace
2101     attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2102     If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, SwFace, nom, 0, 2) ' 0 = swThisconfig
2103     While attr Is Nothing
2104     no += 1
2105     nom = "FaceInterne" & CStr(no)
2106     attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, SwFace, nom, 0, 2)
2107     End While
2108     GererDossiers("FaceInternes", nom)
2109    
2110     End Sub
2111    
2112    
2113     End Class