ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SuperFace.vb
Revision: 205
Committed: Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size: 91614 byte(s)
Log Message:
Commit de MAGiC_SLD pendant que j'y pense.  Les modifications ne devraient pas concerner personne d'autre que moi.   -- Sylvain

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