ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SuperFace.vb
Revision: 48
Committed: Wed Aug 22 21:18:12 2007 UTC (17 years, 8 months ago) by bournival
File size: 85735 byte(s)
Log Message:
On passe aux nouveaux .dll

File Contents

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