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

File Contents

# User Rev Content
1 bournival 48 Imports SolidWorks.Interop
2     Imports SolidWorks.Interop.swconst
3     Imports SolidWorks.Interop.swpublished
4 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 bournival 130 Public Sub New(ByRef Face As sldworks.Face2, ByRef encapsulateur As Boolean)
46 bournival 40 lst_Faces.Add(Face)
47     End Sub
48    
49 bournival 130 Friend Sub New(ByRef face As sldworks.Face2, Optional ByVal tip As Integer = 0)
50 bournival 40 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 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
63     ' MsgBox("La fonction non overridée a été appelée!")
64     ' Return Nothing
65     'End Function
66 bournival 40
67 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
68     ' MsgBox("La fonction non overridée a été appelée!")
69     ' Return Nothing
70     'End Function
71 bournival 40
72     ''' <summary>
73 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
74 bournival 40 ''' </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 bournival 130 If swSommet2 Is Nothing Then ' un cercle (ou ellipse)
99 bournival 40 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 bournival 130 swSketch = swModel.GetActiveSketch2()
118     If swSketch Is Nothing Then swModel.Insert3DSketch2(True) : swSketch = swModel.GetActiveSketch2()
119     If swSketch Is Nothing Then MsgBox("Ça merde vraiment...")
120 bournival 40 swModel.CreateLine2(x1, y1, z1, x2, y2, z2)
121     swModel.Insert3DSketch2(True)
122     swEnt = swSketch : swEnt.Select2(False, 1)
123     swModel.InsertCompositeCurve()
124    
125     ' reste à lui mettre les propriétés de mini-poutres
126     feat = swModel.FeatureByPositionReverse(0)
127     refCourbe = feat.GetSpecificFeature2
128     swArete = refCourbe.GetFirstSegment ' y'a juste un segment
129    
130     swEnt = swArete
131     Dim NomAttr As String
132     NomAttr = "miniPoutre" & Me.nom & k
133    
134     attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, swArete, NomAttr, 0, 0)
135     ' mettre les propriétés de la mini-poutre
136     ' attention, elle ne doit pas avoir de masse, sa section est alors Mini...
137    
138     p = attr.GetParameter("As")
139     p.SetDoubleValue2(-7, 2, "")
140     Commun.GererDossiers("Poutres", NomAttr)
141     k += 1
142    
143    
144     End Sub
145    
146    
147     Friend Overridable Function AjouterInterFace(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterCoqueVolume
148     ' sub qui CRÉÉ une instance de la classe InterFaceFace si et seulement si il n'en existe pas avant
149    
150    
151     'Dim int As InterFaceFace
152    
153     ' créez la routine qui ignore la création de
154     Return Nothing ' pout l'instant
155     End Function
156    
157    
158    
159     Shared Sub reinitialiser()
160     compteur = 0
161     End Sub
162    
163     Public Overrides Sub SaveNom()
164     ' procédure qui enregistre le nom et qui , pour l'instant ne tient pas compte des conditions aux limites
165     Dim ent As SldWorks.Entity
166     Dim i As Long
167     Dim nomtemp As String
168     'For i = 1 To Me.lst_Faces.Count
169     For Each swFace As SldWorks.Face2 In Me.lst_Faces
170     ent = swFace
171     Dim retval As Boolean
172     If Me.lst_Faces.Count > 1 Then nomtemp = nom & "-" & Chr(i + 96) Else nomtemp = nom
173     retval = swPart.SetEntityName(ent, nomtemp)
174     If retval = False Then
175     Dim nom2 As String
176     'Dim swface As SldWorks.Face2
177     'swface = ent
178     'If Me.SwFace Is swface Then MsgBox("La même face!")
179     nom2 = swPart.GetEntityName(ent)
180     '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")
181     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")
182     End If
183     Next
184    
185    
186    
187     End Sub
188    
189    
190     Public Function GetNormale(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double()
191     Dim surf As SldWorks.Surface
192     Dim retval As Object
193     Dim temp(2) As Double
194    
195     surf = Me.lst_Faces.Item(0).GetSurface
196     retval = surf.EvaluateAtPoint(x, y, z)
197    
198     If retval Is Nothing Then MsgBox("Erreur, dans le Getnormal de la face, le point ne semble pas être sur la face")
199    
200     temp(0) = retval(0)
201     temp(1) = retval(1)
202     temp(2) = retval(2)
203    
204     Return temp
205     End Function
206     Public Function GetNormaleSurface(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double()
207     Dim surf As SldWorks.Surface
208     Dim retval As Object = Nothing
209     Dim temp(2) As Double
210    
211     surf = Me.lst_Faces.Item(0).GetSurface
212     retval = surf.EvaluateAtPoint(x, y, z)
213    
214     temp(0) = retval(0)
215     temp(1) = retval(1)
216     temp(2) = retval(2)
217    
218     Return temp
219     End Function
220    
221    
222    
223     Public Function GetRayonCourbureMax(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
224     Dim surf As SldWorks.Surface
225     Dim retval As Object
226     Dim temp As Double
227    
228     surf = Me.lst_Faces.Item(0).GetSurface
229     retval = surf.EvaluateAtPoint(x, y, z)
230    
231     temp = retval(9)
232    
233     Return temp
234     End Function
235    
236     Public Function GetRayonCourbureMin(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
237     Dim surf As SldWorks.Surface
238     Dim retval As Object
239     Dim temp As Double
240    
241     surf = Me.lst_Faces.Item(0).GetSurface
242     retval = surf.EvaluateAtPoint(x, y, z)
243    
244     temp = retval(10)
245    
246     Return temp
247     End Function
248    
249     ' si la surface est un cylindre, retourne son rayon. Plante ou valeur aléatoire si pas un cylindre
250     Public Function GetRayonCylindre() As Double
251     Dim surf As SldWorks.Surface
252     Dim retval As Object
253     Dim temp As Double
254    
255     surf = Me.lst_Faces.Item(0).GetSurface
256     retval = surf.CylinderParams
257    
258     temp = retval(6)
259    
260     Return temp
261     End Function
262    
263    
264     ''' <summary>
265     ''' Retourne vrai si une face est plane
266     ''' </summary>
267     ''' <returns></returns>
268     ''' <remarks></remarks>
269     Public Function estPlan() As Boolean
270     Dim surf As SldWorks.Surface
271    
272     surf = Me.lst_Faces.Item(0).GetSurface()
273    
274     If surf.IsPlane Then Return True Else Return False
275    
276     End Function
277    
278    
279     ''' <summary>
280     ''' Retourne vrai si la face est un plan mais pas vu comme tel par solidworks.
281     ''' </summary>
282     ''' <param name="x"></param>
283     ''' <param name="y"></param>
284     ''' <param name="z"></param>
285     ''' <returns></returns>
286     ''' <remarks></remarks>
287     Public Function estFauxPlan(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean
288     Dim surf As SldWorks.Surface
289     surf = Me.lst_Faces.Item(0).GetSurface()
290     If Not surf.IsParametric Then Return False
291    
292     ' si la normale est la même au point d'intersection et à quelques sommets, alors on a une face plane.
293     Dim Normale(2) As Double
294     Dim vNormale As Object
295    
296     vNormale = surf.EvaluateAtPoint(x, y, z) ' la normale du point d'intersection
297     Normale(0) = vNormale(0)
298     Normale(1) = vNormale(1)
299     Normale(2) = vNormale(2)
300    
301     Dim i As Integer
302     Dim U As Double, V As Double, Umin As Double, Umax As Double, Vmin As Double, Vmax As Double
303     Dim retval As Object
304    
305     retval = surf.Parameterization()
306     Umin = retval(0)
307     Umax = retval(1)
308     Vmin = retval(2)
309     Vmax = retval(3)
310    
311     Randomize()
312    
313     For i = 0 To 5
314     U = Rnd() * (Umax - Umin) + Umin
315     V = Rnd() * (Vmax - Vmin) + Vmin
316     vNormale = surf.Evaluate(U, V, 0, 0)
317     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
318     Next i
319    
320     Return True
321    
322    
323    
324     End Function
325    
326     Public Function estCylindre() As Boolean
327     Dim surf As SldWorks.Surface
328    
329     surf = Me.lst_Faces.Item(0).GetSurface
330    
331     If surf.IsCylinder Then Return True Else Return False
332    
333     End Function
334    
335    
336     Protected Overrides Sub Finalize()
337     ' mettre l'effacement des listes ici.
338    
339     MyBase.Finalize()
340     End Sub
341    
342    
343    
344     Public Sub MettreAttributPourConditionLimite()
345     Dim swent As SldWorks.Entity
346     Dim nom As String
347     Dim cond As String
348    
349     cond = Me.condition
350     If cond = "" Then Exit Sub
351    
352     swent = Me.SwFace
353    
354     nom = Me.nom & "CL" & CStr(no) & "_" & cond
355     Dim Attr As SldWorks.Attribute = Nothing
356    
357     Try
358     Attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
359     Catch ex As Exception
360     MsgBox("N'arrive pas à se lier à l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
361     End Try
362    
363     If Attr Is Nothing Then Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.SwFace, nom, 0, 2) ' 0 = swThisconfig
364    
365    
366     While Attr Is Nothing
367     no += 1
368     nom = "CL" & Me.nom & "_" & cond
369     Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.SwFace, nom, 0, 0)
370     End While
371    
372    
373     Dim ParamCL As SldWorks.Parameter
374     ParamCL = Attr.GetParameter("CL")
375    
376     ParamCL.SetStringValue2(cond, 2, "") ' swAllConfiguration = 2
377     Me.AttributCL = Attr
378     GererDossiers("Conditions Aux Limites", nom)
379     no = no + 1
380    
381     End Sub
382    
383     ' une fonction qui transforme un attribut en condition aux limites
384     Public Sub AttributVersConditionLimite()
385     Dim p As SldWorks.Parameter
386     Dim ent As SldWorks.Entity
387     Dim attr As SldWorks.Attribute
388    
389     ent = Me.SwFace
390     attr = ent.FindAttribute(Intersections.DefAttrConditionLimite, 0)
391     If Not attr Is Nothing Then
392     p = attr.GetParameter("CL")
393     nom = nomOrig & "@" & p.GetStringValue
394     End If
395    
396     End Sub
397    
398    
399 bournival 130
400 bournival 40
401    
402     ' sub qui coupe la face avec une arète qui repose dessus.
403     Friend Sub CoupeLong(ByRef inter As InterPoutreVolume, ByVal poutre As SlyAretePoutre)
404    
405    
406 bournival 130 'Dim swEnt As SldWorks.Entity
407     'Dim swSketchSegment As SldWorks.SketchSegment
408     'Dim vSketchSegments As Object
409     'Dim swSketch As SldWorks.Sketch
410     'Dim faceinterne(1) As SldWorks.Face2
411     'Dim swPlan As SldWorks.RefPlane = Nothing
412     'Dim b As Integer
413     'Dim swSommet As SldWorks.Vertex
414     'Dim i As Integer
415 bournival 40
416 bournival 130 'swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
417 bournival 40
418 bournival 130 '' faut découper toutes les faces de la liste si elles ne sont pas des faces internes
419     'Dim MeFace As SldWorks.Face2
420     ''Dim ListeFace() As SldWorks.Face2
421     ''ReDim ListeFace(Me.lst_Faces.Count - 1)
422 bournival 40
423 bournival 130 ''For i = 1 To Me.lst_Faces.Count
424     ''ListeFace(i - 1) = Me.lst_Faces.Item(i)
425     ''Next
426 bournival 40
427 bournival 130 'For Each MeFace In Me.lst_Faces 'ListeFace
428 bournival 40
429 bournival 130 ' If Me.estPlan Then
430     ' swEnt = MeFace
431     ' swEnt.Select(False)
432     ' swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
433     ' swEnt.Select(False)
434     ' swModel.InsertSketch2(True)
435 bournival 40
436 bournival 130 ' swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
437 bournival 40
438 bournival 130 ' ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
439     ' If b = 0 Then
440     ' Dim vEdge As Object
441 bournival 40
442    
443 bournival 130 ' vEdge = MeFace.GetEdges
444     ' swModel.ClearSelection2(True)
445     ' While swPlan Is Nothing
446     ' 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
447     ' swSommet = vEdge(i).GetStartVertex()
448     ' swEnt = swSommet
449     ' swEnt.Select4(False, Nothing)
450     ' swSommet = vEdge(i + 1).GetStartVertex()
451     ' swEnt = swSommet
452     ' swEnt.Select4(True, Nothing)
453     ' swSommet = vEdge(i + 2).GetStartVertex()
454     ' swEnt = swSommet
455     ' swEnt.Select4(True, Nothing)
456     ' i += 1
457     ' swPlan = swModel.CreatePlaneThru3Points3(False)
458 bournival 40
459 bournival 130 ' End While
460     ' End If
461     ' swEnt = swPlan
462     ' swEnt.Select(False)
463     ' swModel.InsertSketch2(True)
464 bournival 40
465 bournival 130 ' Else
466     ' MsgBox("Dans coupeLong, on a un type de face qui n'est pas encore traité")
467 bournival 40
468 bournival 130 ' End If
469 bournival 40
470    
471 bournival 130 ' swSketch = swModel.GetActiveSketch2
472 bournival 40
473 bournival 130 ' swEnt = poutre.swArete
474     ' swEnt.Select(False)
475 bournival 40
476 bournival 130 ' ' créer la ligne de «conversion de entités»
477     ' swModel.SketchUseEdge2(False)
478 bournival 40
479 bournival 130 ' vSketchSegments = swSketch.GetSketchSegments()
480     ' swSketchSegment = vSketchSegments(0)
481     ' swSketchSegment.Select2(False, 1) 'on sélectionne l'arète de poutre...
482 bournival 40
483 bournival 130 ' Dim x As Double, y As Double, z As Double
484     ' Commun.GetMidPointSegment(swSketchSegment, x, y, z)
485 bournival 40
486    
487 bournival 130 ' ' sketchoffset doit avoir un mark de 1 pour l'objet à offsetter. Une valeur négative inverse la direction
488     ' swModel.SketchManager.SketchOffset(poutre.GetD2, False, 0, 0, 0, 0)
489     ' ' pour rendre le modèle plus beau, on peut enlever la contrainte de offset et laisser solidworks mettre des contraintes automatiques...
490 bournival 40
491 bournival 130 ' Dim retval As Object
492     ' Dim skPointA1 As sldworks.SketchPoint = Nothing, skPointA2 As sldworks.SketchPoint = Nothing, skPointB1 As sldworks.SketchPoint = Nothing, skPointB2 As sldworks.SketchPoint = Nothing
493 bournival 40
494 bournival 130 ' vSketchSegments = swSketch.GetSketchSegments()
495     ' swSketchSegment = vSketchSegments(1)
496 bournival 40
497    
498 bournival 130 ' Select Case swSketchSegment.GetType()
499     ' Case 0 ' on a une ligne
500     ' Dim sketchline As sldworks.SketchLine
501     ' sketchline = swSketchSegment
502     ' skPointA1 = sketchline.GetStartPoint2
503     ' skPointA2 = sketchline.GetEndPoint2()
504     ' Case 1 ' arc
505     ' Dim arc As sldworks.SketchArc
506     ' arc = swSketchSegment
507     ' skPointA1 = arc.GetStartPoint
508     ' skPointA2 = arc.GetEndPoint2
509     ' Case 2 ' ellipse
510     ' Dim sketchEllipse As sldworks.SketchEllipse
511     ' sketchEllipse = swSketchSegment
512     ' skPointA1 = sketchEllipse.GetStartPoint2
513     ' skPointA2 = sketchEllipse.GetEndPoint2
514     ' Case 3 ' spline
515     ' Dim spline As sldworks.SketchSpline
516     ' Dim pts() As sldworks.SketchPoint
517     ' spline = swSketchSegment
518     ' retval = spline.GetPoints2()
519     ' pts = retval
520     ' skPointA1 = pts(0)
521     ' skPointA2 = pts(UBound(pts))
522     ' Case 5 ' parabole (le 4 est du texte)
523     ' Dim para As sldworks.SketchParabola
524     ' para = swSketchSegment
525     ' skPointA1 = para.GetStartPoint2
526     ' skPointA2 = para.GetEndPoint2
527     ' End Select
528 bournival 40
529 bournival 130 ' swSketchSegment = vSketchSegments(0)
530     ' Select Case swSketchSegment.GetType()
531     ' Case 0 ' on a une ligne
532     ' Dim sketchline As sldworks.SketchLine
533     ' sketchline = swSketchSegment
534     ' skPointB1 = sketchline.GetStartPoint2
535     ' skPointB2 = sketchline.GetEndPoint2()
536     ' Case 1 ' arc
537     ' Dim arc As sldworks.SketchArc
538     ' arc = swSketchSegment
539     ' skPointB1 = arc.GetStartPoint
540     ' skPointB2 = arc.GetEndPoint2
541     ' Case 2 ' ellipse
542     ' Dim sketchEllipse As sldworks.SketchEllipse
543     ' sketchEllipse = swSketchSegment
544     ' skPointB1 = sketchEllipse.GetStartPoint2
545     ' skPointB2 = sketchEllipse.GetEndPoint2
546     ' Case 3 ' spline
547     ' Dim spline As sldworks.SketchSpline
548     ' Dim pts() As sldworks.SketchPoint
549     ' spline = swSketchSegment
550     ' retval = spline.GetPoints2()
551     ' pts = retval
552     ' skPointB1 = pts(0)
553     ' skPointB2 = pts(UBound(pts))
554     ' Case 5 ' parabole (le 4 est du texte)
555     ' Dim para As sldworks.SketchParabola
556     ' para = swSketchSegment
557     ' skPointB1 = para.GetStartPoint2
558     ' skPointB2 = para.GetEndPoint2
559     ' End Select
560 bournival 40
561 bournival 130 ' ' création des 2 lignes pour fermer le sketch.
562     ' swModel.CreateLine2(skPointA1.X, skPointA1.Y, 0, skPointB1.X, skPointB1.Y, 0)
563     ' swModel.CreateLine2(skPointA2.X, skPointA2.Y, 0, skPointB2.X, skPointB2.Y, 0)
564 bournival 40
565    
566 bournival 130 ' Dim x2 As Double, y2 As Double, z2 As Double ' le midpoint de la poutre
567     ' Dim x3 As Double, y3 As Double, z3 As Double ' le midpoint de la poutre
568 bournival 40
569 bournival 130 ' swSketchSegment = vSketchSegments(0) ' le midpoint d'une poutre
570     ' Commun.GetMidPointSegment(swSketchSegment, x2, y2, z2)
571 bournival 40
572 bournival 130 ' swSketchSegment = vSketchSegments(1) ' le midpoint de l'autre poutre
573     ' Commun.GetMidPointSegment(swSketchSegment, x3, y3, z3)
574 bournival 40
575 bournival 130 ' Dim sk(1) As Double, r(2) As Double
576     ' sk(0) = (x3 + x2) / 2
577     ' sk(1) = (y3 + y2) / 2
578     ' r = Commun.TransfertSketchToModel(swSketch, sk)
579 bournival 40
580 bournival 130 ' swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
581     ' swModel.ClearSelection2(True)
582     ' swEnt = MeFace : swEnt.Select2(False, 1)
583     ' swEnt = swSketch : swEnt.Select2(True, 4)
584 bournival 40
585 bournival 130 ' swModel.InsertSplitLineProject(False, False)
586 bournival 40
587 bournival 130 ' Me.Flag = 20 ' pour dire que l'on a un coupeLong
588     ' 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
589     ' Me.Flag = 0
590 bournival 40
591    
592     End Sub
593    
594    
595    
596 bournival 130 ''' <summary>
597     ''' Sub qui appelle le découpage de la face
598     ''' </summary>
599     ''' <remarks>On devrait revoir cette sub en fonction des nouveaux outils de VB2005</remarks>
600     Public Overridable Sub decouper()
601     MsgBox("La fonction non Overridé a été appelée!")
602 bournival 40 End Sub
603    
604    
605 bournival 130 ''' <summary>
606     ''' Renvoie le nombre d'arêtes dans la face principale
607     ''' </summary>
608     ''' <value></value>
609     ''' <returns></returns>
610     ''' <remarks></remarks>
611     Public ReadOnly Property NbSommets() As Integer
612     Get
613     Dim lst_sommets As New Collections.Generic.List(Of sldworks.Vertex)
614     Dim swSommet As sldworks.Vertex = Nothing
615     Dim vedges As Object = Me.SwFace.GetEdges
616     For Each edge As sldworks.Edge In vedges
617     swSommet = edge.GetStartVertex
618     If swSommet IsNot Nothing Then
619     lst_sommets.Add(swSommet)
620     swSommet = edge.GetEndVertex
621     lst_sommets.Add(swSommet)
622     End If
623 bournival 40 Next
624 bournival 130 Return lst_sommets.Count
625     End Get
626     End Property
627 bournival 40
628 bournival 130 ''' <summary>
629     ''' 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
630     ''' </summary>
631     ''' <param name="inter"></param>
632     ''' <remarks></remarks>
633     Protected Sub CoupeFaceDeSection(ByRef inter As InterPoutreVolume)
634     Dim swEnt As sldworks.Entity = Nothing
635 bournival 40 Dim Directionnel As Boolean
636 bournival 130 Dim Faces(3) As sldworks.Face2
637 bournival 40 Dim r(2) As Double
638     Dim p(2) As Double
639 bournival 130 Dim planReference As sldworks.RefPlane = Nothing
640     Dim swsketch As sldworks.Sketch
641 bournival 40 Dim pointdeb(2) As Double, pointfin(2) As Double
642 bournival 130 Dim sketchline As sldworks.SketchLine
643     Dim swFeat As sldworks.Feature
644 bournival 40
645    
646     swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
647    
648     swEnt = Me.SwFace
649     swEnt.Select(False)
650     swModel.InsertSketch2(False)
651     swsketch = swModel.GetActiveSketch2
652    
653 bournival 130 ' dessin de la forme à faire SI NÉCESSAIRE
654     If Me.NbSommets = 0 OrElse Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
655 bournival 40
656 bournival 130 Dim xyzc() As Double, xyz(2) As Double
657     xyz(0) = inter.x : xyz(1) = inter.y : xyz(2) = inter.z
658     xyzc = Commun.TransfertModelSketch(swsketch, xyz)
659 bournival 40
660 bournival 130 sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) + Math.Cos(Pi / 8), xyzc(1) + Math.Sin(Pi / 8), 0)
661     sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) - Math.Cos(Pi / 8), xyzc(1) + Math.Sin(Pi / 8), 0)
662     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
663 bournival 40
664 bournival 130 swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
665     swModel.ClearSelection2(True)
666 bournival 40
667 bournival 130 swEnt = Me.SwFace : swEnt.Select2(False, 1)
668     swEnt = swsketch : swEnt.Select2(True, 4)
669     swModel.InsertSplitLineProject(Directionnel, False)
670 bournival 40
671    
672 bournival 130 ' flagger les 2 faces comme faces Internes.
673     Dim vface As Object
674     Dim face As sldworks.Face2 = Nothing
675     swFeat = swModel.FeatureByPositionReverse(0)
676     Try
677     vface = swFeat.GetFaces
678     For Each face In vface
679     no = Me.MettreAttributFaceInterne(face, 2 * Me.Aire / Me.Perimetre, True) ' plus certain que l'on a besoin du numéro
680     Me.AjouterFace(face)
681     Next face
682     Catch
683     ' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
684     ' on doit donc le déterminer anyway
685     End Try
686 bournival 40
687 bournival 130 ' si ça ne touche pas à la face
688     If Not Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
689     AjouterMiniPoutresSurFaceInterne(inter.lst_sPoutre.Item(1), face, inter.x, inter.y, inter.z)
690     '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") & " )")
691     End If
692 bournival 40
693 bournival 130 Else ' flagger la seule face comme face interne
694     Me.MettreAttributFaceInterne(Me.SwFace, 2 * Me.Aire / Me.Perimetre, True)
695     If Not Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
696     AjouterMiniPoutresSurFaceInterne(inter.lst_sPoutre.Item(1), Me.SwFace, inter.x, inter.y, inter.z)
697     '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") & " )")
698     End If
699 bournival 40 End If
700     swModel.SetInferenceMode(True)
701    
702     End Sub
703    
704    
705     Friend Overridable Sub chercherAttributs()
706 bournival 130 Dim swEnt As sldworks.Entity
707     Dim attr As sldworks.Attribute
708 bournival 40
709     swEnt = Me.SwFace
710    
711     attr = swEnt.FindAttribute(Intersections.DefAttrConditionLimite, 0)
712     If Not attr Is Nothing Then Me.AttributCL = attr : attr = Nothing
713    
714     'attr = swent.findattribute(intersections.DefAttrFaceInterne,0) ' ne devrait pas s'entrecouper...
715    
716     End Sub
717    
718 bournival 130 Protected Function Flipper(ByRef PlanDessus As sldworks.RefPlane, ByRef inter As InterAreteFace) As Boolean
719 bournival 40 ' function qui dit si l'on doit flipper le sens du plan de référence.
720     ' calcul de la direction à prendre
721     Dim retval As Object
722     Dim ret(8) As Double
723     Dim ret2(6) As Double
724     Dim normalePlan(2) As Double
725     Dim OV(2) As Double
726 bournival 130 Dim swSurf As sldworks.Surface
727 bournival 40
728     retval = PlanDessus.GetRefPlaneParams()
729     ret = retval
730     normalePlan(0) = ret(6) : normalePlan(1) = ret(7) : normalePlan(2) = ret(8)
731 bournival 130 swSurf = Me.lst_Faces.Item(0).GetSurface
732 bournival 40 retval = swSurf.CylinderParams() ' 7 doubles, les 3 premiers sont l'origine
733     ret2 = retval
734     OV(0) = ret2(0) - inter.x : OV(1) = ret2(1) - inter.y : OV(2) = ret2(2) - inter.z
735    
736     ' l'angle est le produit scalaire divisé par la norme des 2 vecteurs
737     Dim temp As Double = Outils_Math.Angle2Vecteurs(OV, normalePlan)
738     If (temp < Pi / 2) And (temp > -Pi / 2) Then Return False Else Return True
739    
740     End Function
741    
742 bournival 130 ''' <summary>
743     ''' Sub qui dessine (insère des lignes) sur le sketch en fonction de la forme de la poutre.
744     ''' </summary>
745     ''' <param name="Poutre"></param>
746     ''' <param name="TranslationX"></param>
747     ''' <param name="TranslationY"></param>
748     ''' <param name="numero"></param>
749     ''' <param name="swSketch"></param>
750     ''' <param name="inter"></param>
751     ''' <param name="MettreFI"></param>
752     ''' <returns></returns>
753     ''' <remarks></remarks>
754     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) As Double()
755 bournival 40 ' le sketch est déjà inséré, il faut juste mettre des swmodel.line ou autre
756     ' doit retourner r() qui est un point situé à l'intérieur de la coupe
757 bournival 130 Dim sketchline As sldworks.SketchSegment
758 bournival 40 Dim longueur As Double
759     Dim r(2) As Double
760     Dim sk(1) As Double
761     Dim i As Integer
762     Dim Ligne() As Double = Nothing ' liste des lignes (4 valeurs par ligne)
763     Dim pt3() As Double
764     Dim Nomsection As String
765    
766     MettreFI = True
767    
768     ' on doit activer le sketch avant d'utiliser la fonction getactivesketch
769     pt3 = Poutre.GetPoint3
770     longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
771     Dim IP(2) As Double ' IP est le vecteur directionnel
772     IP(0) = pt3(0) - inter.x : IP(1) = pt3(1) - inter.y : IP(2) = pt3(2) - inter.z
773    
774    
775     pt3 = Commun.TransfertModelSketch(swSketch, pt3)
776     longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
777    
778     Nomsection = Poutre.GetNomSection
779     If Nomsection = "Rectangle" Or Nomsection = " Rectangle générique" Then ' un rectangle
780     Select Case numero
781     Case 1
782     Dim P(2, 1) As Double
783     P(0, 0) = 0
784     P(0, 1) = 0
785     P(1, 0) = Poutre.GetD1 / 2
786     P(1, 1) = -Poutre.GetD2 / 2
787     P(2, 0) = Poutre.GetD1 / 2
788     P(2, 1) = Poutre.GetD2 / 2
789    
790     ReDim Ligne(11)
791     pt3(0) -= TranslationX
792     pt3(1) -= TranslationY
793     For i = 0 To 2
794     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
795     P(i, 0) += TranslationX
796     P(i, 1) += TranslationY
797     Next i
798    
799     For i = 0 To 1
800     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)
801     Next i
802     Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(0, 0) : Ligne(11) = P(0, 1)
803    
804     r(0) = inter.x + 5000 * Epsilon * IP(0)
805     r(1) = inter.y + 5000 * Epsilon * IP(1)
806     r(2) = inter.z + 5000 * Epsilon * IP(2)
807    
808     Case 2
809     ReDim Ligne(19)
810    
811     Dim p(4, 1) As Double
812     p(0, 0) = 0
813     p(0, 1) = 0
814     p(1, 0) = Poutre.GetD1 / 2
815     p(1, 1) = Poutre.GetD2 / 2
816     p(2, 0) = -Poutre.GetD1 / 2
817     p(2, 1) = Poutre.GetD2 / 2
818     p(3, 0) = -Poutre.GetD1 / 2
819     p(3, 1) = -Poutre.GetD2 / 2
820     p(4, 0) = Poutre.GetD1 / 2
821     p(4, 1) = -Poutre.GetD2 / 2
822    
823    
824     pt3(0) -= TranslationX
825     pt3(1) -= TranslationY
826     pt3(0) /= longueur : pt3(1) /= longueur
827     For i = 0 To 4
828     Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
829     p(i, 0) += TranslationX
830     p(i, 1) += TranslationY
831     Next i
832    
833     For i = 0 To 3
834     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)
835     Next i
836     Ligne(16) = p(4, 0) : Ligne(17) = p(4, 1) : Ligne(18) = p(0, 0) : Ligne(19) = p(0, 1)
837     r(0) = inter.x - 5000 * Epsilon * IP(0)
838     r(1) = inter.y - 5000 * Epsilon * IP(1)
839     r(2) = inter.z - 5000 * Epsilon * IP(2)
840    
841     End Select
842     MettreFI = True
843     ElseIf Left(Nomsection, 2) = "ST" Or Nomsection = " Tube carré générique" Then ' tube carré troué
844     Dim P(3, 1) As Double
845     Select Case numero
846     Case 1
847     P(0, 0) = Poutre.GetD1 / 2
848     P(0, 1) = -Poutre.GetD2 / 2
849     P(1, 0) = P(0, 0)
850     P(1, 1) = -P(0, 1)
851     P(2, 0) = -P(0, 0)
852     P(2, 1) = P(1, 1)
853     P(3, 0) = P(2, 0)
854     P(3, 1) = P(0, 1)
855    
856     r(0) = P(0, 0) - 1000 * Epsilon
857     r(1) = 0 : r(2) = 0
858     Outils_Math.Rotation2D(pt3, r(0), r(1))
859     r(0) += TranslationX
860     r(1) += TranslationY
861     r = Commun.TransfertSketchToModel(swSketch, r)
862    
863     pt3(0) -= TranslationX
864     pt3(1) -= TranslationY
865     pt3(0) /= longueur : pt3(1) /= longueur
866     For i = 0 To 3
867     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
868     P(i, 0) += TranslationX
869     P(i, 1) += TranslationY
870     Next i
871    
872     ReDim Ligne(15)
873     Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
874     Ligne(4) = P(1, 0) : Ligne(5) = P(1, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
875     Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(3, 0) : Ligne(11) = P(3, 1)
876     Ligne(12) = P(3, 0) : Ligne(13) = P(3, 1) : Ligne(14) = P(0, 0) : Ligne(15) = P(0, 1)
877     MettreFI = False
878    
879     Case 2
880     P(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
881     P(0, 1) = -Poutre.GetD2 / 2 + Poutre.GetD3
882     P(1, 0) = P(0, 0)
883     P(1, 1) = -P(0, 1)
884     P(2, 0) = -P(1, 0)
885     P(2, 1) = P(1, 1)
886     P(3, 0) = P(2, 0)
887     P(3, 1) = P(0, 1)
888    
889     r(0) = P(0, 0) + 1000 * Epsilon
890     r(1) = 0 : r(2) = 0
891     Outils_Math.Rotation2D(pt3, r(0), r(1))
892     r(0) += TranslationX
893     r(1) += TranslationY
894     r = Commun.TransfertSketchToModel(swSketch, r)
895    
896     pt3(0) -= TranslationX
897     pt3(1) -= TranslationY
898     pt3(0) /= longueur : pt3(1) /= longueur
899     For i = 0 To 3
900     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
901     P(i, 0) += TranslationX
902     P(i, 1) += TranslationY
903     Next i
904    
905     ReDim Ligne(15)
906     Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
907     Ligne(4) = P(1, 0) : Ligne(5) = P(1, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
908     Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(3, 0) : Ligne(11) = P(3, 1)
909     Ligne(12) = P(3, 0) : Ligne(13) = P(3, 1) : Ligne(14) = P(0, 0) : Ligne(15) = P(0, 1)
910    
911     MettreFI = True ' lorsque l'on sort on met une face interne
912    
913     End Select
914    
915    
916     ElseIf Left(Nomsection, 1) = "S" Or Nomsection = " Poutre en I générique" Then ' poutre en I de type S
917     Dim P(8, 1) As Double
918    
919     Select Case numero
920     Case 1
921     Dim d As Double
922     d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
923    
924     P(0, 0) = 0
925     P(0, 1) = 0
926     P(1, 0) = -d
927     P(1, 1) = -Poutre.GetD4 / 2.0R
928     P(2, 0) = (Poutre.GetD1 / 2) - Poutre.GetD3
929     P(2, 1) = -Poutre.GetD4 / 2.0R
930     P(3, 0) = P(2, 0)
931     P(3, 1) = -Poutre.GetD2 / 2
932     P(4, 0) = Poutre.GetD1 / 2
933     P(4, 1) = P(3, 1)
934     P(5, 0) = P(4, 0)
935     P(5, 1) = -P(4, 1)
936     P(6, 0) = P(3, 0)
937     P(6, 1) = -P(3, 1)
938     P(7, 0) = P(2, 0)
939     P(7, 1) = -P(2, 1)
940     P(8, 0) = P(1, 0)
941     P(8, 1) = -P(1, 1)
942    
943     pt3(0) -= TranslationX
944     pt3(1) -= TranslationY
945     pt3(0) /= longueur : pt3(1) /= longueur
946     For i = 0 To 8
947     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
948     P(i, 0) += TranslationX
949     P(i, 1) += TranslationY
950     Next i
951    
952     ReDim Ligne(35)
953     For i = 0 To 7
954     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)
955     Next i
956     Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
957     r(0) = inter.x + 5000 * Epsilon * IP(0)
958     r(1) = inter.y + 5000 * Epsilon * IP(1)
959     r(2) = inter.z + 5000 * Epsilon * IP(2)
960     Case 2
961    
962     Dim d As Double
963     d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
964    
965     P(0, 0) = 0
966     P(0, 1) = 0
967    
968     P(1, 0) = -d
969     P(1, 1) = -Poutre.GetD4 / 2.0R
970     P(2, 0) = -((Poutre.GetD1 / 2) - Poutre.GetD3)
971     P(2, 1) = -Poutre.GetD4 / 2.0R
972     P(3, 0) = P(2, 0)
973     P(3, 1) = -Poutre.GetD2 / 2
974     P(4, 0) = -Poutre.GetD1 / 2
975     P(4, 1) = P(3, 1)
976     P(5, 0) = P(4, 0)
977     P(5, 1) = -P(4, 1)
978     P(6, 0) = P(3, 0)
979     P(6, 1) = -P(3, 1)
980     P(7, 0) = P(2, 0)
981     P(7, 1) = -P(2, 1)
982     P(8, 0) = P(1, 0)
983     P(8, 1) = -P(1, 1)
984    
985     pt3(0) -= TranslationX
986     pt3(1) -= TranslationY
987     pt3(0) /= longueur : pt3(1) /= longueur
988     For i = 0 To 8
989     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
990     P(i, 0) += TranslationX
991     P(i, 1) += TranslationY
992     Next i
993    
994     ReDim Ligne(35)
995     For i = 0 To 7
996     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)
997     Next i
998     Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
999    
1000     r(0) = inter.x - 5000 * Epsilon * IP(0)
1001     r(1) = inter.y - 5000 * Epsilon * IP(1)
1002     r(2) = inter.z - 5000 * Epsilon * IP(2)
1003    
1004     End Select
1005     MettreFI = True
1006    
1007 bournival 130 ElseIf Left(Nomsection, 5) = "Tuyau" OrElse Nomsection = " Tuyau (Pipe) générique" Then ' le tube rond
1008 bournival 40 Dim p(4, 1) As Double
1009     p(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
1010     p(0, 1) = 0
1011     p(1, 0) = Poutre.GetD1 / 2
1012     p(1, 1) = 0
1013     p(2, 0) = -p(0, 0)
1014     p(2, 1) = 0
1015     p(3, 0) = -p(1, 0)
1016     p(3, 1) = 0
1017     p(4, 0) = 0
1018     p(4, 1) = 0
1019    
1020     Select Case numero
1021     Case 1
1022    
1023     r(0) = 0
1024     r(1) = Poutre.GetD1 / 2 - Poutre.GetD3 / 2 : r(2) = 0
1025     Outils_Math.Rotation2D(pt3, r(0), r(1))
1026     r(0) += TranslationX
1027     r(1) += TranslationY
1028     r = Commun.TransfertSketchToModel(swSketch, r)
1029    
1030     pt3(0) -= TranslationX
1031     pt3(1) -= TranslationY
1032     pt3(0) /= longueur : pt3(1) /= longueur
1033     For i = 0 To 4
1034     Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
1035     p(i, 0) += TranslationX
1036     p(i, 1) += TranslationY
1037     Next i
1038    
1039     ReDim Ligne(7)
1040     Ligne(0) = p(0, 0) : Ligne(1) = p(0, 1) : Ligne(2) = p(1, 0) : Ligne(3) = p(1, 1)
1041     Ligne(4) = p(2, 0) : Ligne(5) = p(2, 1) : Ligne(6) = p(3, 0) : Ligne(7) = p(3, 1)
1042     swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(1, 0), p(1, 1), 0, p(3, 0), p(3, 1), 0, 1)
1043     swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(0, 0), p(0, 1), 0, p(2, 0), p(2, 1), 0, 1)
1044     MettreFI = True
1045     'Flag = 2
1046     Case 2
1047    
1048     r(0) = 0
1049     r(1) = -Poutre.GetD1 / 2 + Poutre.GetD3 / 2 : r(2) = 0
1050     Outils_Math.Rotation2D(pt3, r(0), r(1))
1051     r(0) += TranslationX
1052     r(1) += TranslationY
1053     r = Commun.TransfertSketchToModel(swSketch, r)
1054    
1055     pt3(0) -= TranslationX
1056     pt3(1) -= TranslationY
1057     pt3(0) /= longueur : pt3(1) /= longueur
1058     For i = 0 To 4
1059     Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
1060     p(i, 0) += TranslationX
1061     p(i, 1) += TranslationY
1062     Next i
1063    
1064     ReDim Ligne(7)
1065     Ligne(0) = p(0, 0) : Ligne(1) = p(0, 1) : Ligne(2) = p(1, 0) : Ligne(3) = p(1, 1)
1066     Ligne(4) = p(2, 0) : Ligne(5) = p(2, 1) : Ligne(6) = p(3, 0) : Ligne(7) = p(3, 1)
1067     swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(1, 0), p(1, 1), 0, p(3, 0), p(3, 1), 0, -1)
1068     swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(0, 0), p(0, 1), 0, p(2, 0), p(2, 1), 0, -1)
1069     'MettreFI = True ' lorsque l'on sort on met une face interne
1070     MettreFI = False
1071     Me.Flag = 2
1072     'Case 1 ' le cercle extérieur
1073     ' swModel.CreateCircleByRadius2(TranslationX, TranslationY, 0, Poutre.GetD1 / 2)
1074     ' MettreFI = False
1075     ' r(0) = 0 : r(1) = 0 : r(2) = 0
1076     ' r = Commun.TransfertSketchToModel(swSketch, r)
1077     'Case 2
1078     ' swModel.CreateCircleByRadius2(TranslationX, TranslationY, 0, (Poutre.GetD1 / 2) - Poutre.GetD3)
1079     ' r(0) = (Poutre.GetD1 / 2 - (Poutre.GetD3 / 2))
1080     ' r(1) = 0 : r(2) = 0
1081     ' r = Commun.TransfertSketchToModel(swSketch, r)
1082     ' MettreFI = True
1083     End Select
1084    
1085 bournival 130 ElseIf Left(Poutre.GetNomSection, 2) = "Cy" Or Nomsection = " Cylindrique (Rod) générique" Then ' Pipe,
1086     Dim P(2, 1) As Double
1087     Dim d As Double, e As Double
1088     d = Poutre.GetD1 / 4 ' Math.Sin(30) ( et on doit diviser le diamètre par 2)
1089     e = Poutre.GetD1 * Math.Sqrt(3) / 4 ' cos (30°)
1090    
1091     P(0, 0) = 0
1092     P(0, 1) = 0
1093     P(1, 0) = d
1094     P(1, 1) = -e
1095     P(2, 0) = d
1096     P(2, 1) = e
1097    
1098     Select Case numero
1099     Case 1
1100     r(0) = P(0, 0) + 1000 * Epsilon
1101     r(1) = 0 : r(2) = 0
1102     Outils_Math.Rotation2D(pt3, r(0), r(1))
1103     r(0) += TranslationX
1104     r(1) += TranslationY
1105     r = Commun.TransfertSketchToModel(swSketch, r)
1106     pt3(0) -= TranslationX
1107     pt3(1) -= TranslationY
1108     pt3(0) /= longueur : pt3(1) /= longueur
1109     For i = 0 To 2
1110     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1111     P(i, 0) += TranslationX
1112     P(i, 1) += TranslationY
1113     Next i
1114     ReDim Ligne(7)
1115     Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1116     Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1117     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
1118    
1119     Case 2
1120     r(0) = P(0, 0) - 1000 * Epsilon
1121     r(1) = 0 : r(2) = 0
1122     Outils_Math.Rotation2D(pt3, r(0), r(1))
1123     r(0) += TranslationX
1124     r(1) += TranslationY
1125     r = Commun.TransfertSketchToModel(swSketch, r)
1126    
1127     pt3(0) -= TranslationX
1128     pt3(1) -= TranslationY
1129     pt3(0) /= longueur : pt3(1) /= longueur
1130     For i = 0 To 2
1131     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1132     P(i, 0) += TranslationX
1133     P(i, 1) += TranslationY
1134     Next i
1135     ReDim Ligne(7)
1136     Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1137     Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1138    
1139     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
1140    
1141     End Select
1142     MettreFI = True
1143    
1144    
1145 bournival 40 ElseIf Left(Nomsection, 1) = "C" Or Nomsection = " Poutre en C générique" Then ' le channel
1146     Dim P(7, 1) As Double
1147    
1148     Select Case numero
1149     Case 1 ' le C au complet
1150    
1151     P(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
1152     P(0, 1) = Poutre.GetD5
1153     P(1, 0) = P(0, 0)
1154     P(1, 1) = Poutre.GetD5 + Poutre.GetD4 - Poutre.GetD2
1155     P(2, 0) = Poutre.GetD1 / 2
1156     P(2, 1) = P(1, 1)
1157     P(3, 0) = P(2, 0)
1158     P(3, 1) = P(1, 1) + Poutre.GetD2
1159     P(4, 0) = -P(3, 0)
1160     P(4, 1) = P(3, 1)
1161     P(5, 0) = P(4, 0)
1162     P(5, 1) = P(1, 1)
1163     P(6, 0) = -P(1, 0)
1164     P(6, 1) = P(5, 1)
1165     P(7, 0) = -P(0, 0)
1166     P(7, 1) = P(0, 1)
1167    
1168     r(0) = P(0, 0) + 1000 * Epsilon
1169 bournival 130 r(1) = P(0, 1) : r(2) = 0
1170 bournival 40 Outils_Math.Rotation2D(pt3, r(0), r(1))
1171     r(0) += TranslationX
1172     r(1) += TranslationY
1173     r = Commun.TransfertSketchToModel(swSketch, r)
1174    
1175     pt3(0) -= TranslationX
1176     pt3(1) -= TranslationY
1177     pt3(0) /= longueur : pt3(1) /= longueur
1178     For i = 0 To 7
1179     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1180     P(i, 0) += TranslationX
1181     P(i, 1) += TranslationY
1182     Next i
1183    
1184     ReDim Ligne(35)
1185     For i = 0 To 6
1186     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)
1187     Next i
1188     Ligne(28) = P(7, 0) : Ligne(29) = P(7, 1) : Ligne(30) = P(0, 0) : Ligne(31) = P(0, 1)
1189    
1190     MettreFI = False
1191     Me.Flag = 2
1192     Case 2
1193     MettreFI = False ' Attention, peut planter à cause de ça.
1194     End Select
1195    
1196     ElseIf Left(Nomsection, 1) = "L" Or Nomsection = " Poutre en L générique" Then ' l'Angle en L
1197     Dim P(5, 1) As Double
1198    
1199     Select Case numero
1200     Case 1 ' le C au complet
1201    
1202     P(0, 0) = -Poutre.GetD5 + Poutre.GetD1
1203     P(0, 1) = -Poutre.GetD6 + Poutre.GetD4
1204     P(1, 0) = -Poutre.GetD5 + Poutre.GetD3
1205     P(1, 1) = P(0, 1)
1206     P(2, 0) = P(1, 0)
1207     P(2, 1) = -Poutre.GetD6 + Poutre.GetD2
1208     P(3, 0) = -Poutre.GetD5
1209     P(3, 1) = P(2, 1)
1210     P(4, 0) = P(3, 0)
1211     P(4, 1) = -Poutre.GetD6
1212     P(5, 0) = P(0, 0)
1213     P(5, 1) = P(4, 1)
1214    
1215     r(0) = P(1, 0) - 1000 * Epsilon
1216     r(1) = 0 : r(2) = 0
1217     Outils_Math.Rotation2D(pt3, r(0), r(1))
1218     r(0) += TranslationX
1219     r(1) += TranslationY
1220     r = Commun.TransfertSketchToModel(swSketch, r)
1221    
1222     pt3(0) -= TranslationX
1223     pt3(1) -= TranslationY
1224     pt3(0) /= longueur : pt3(1) /= longueur
1225     For i = 0 To 5
1226     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1227     P(i, 0) += TranslationX
1228     P(i, 1) += TranslationY
1229     Next i
1230    
1231     ReDim Ligne(35)
1232     For i = 0 To 4
1233     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)
1234     Next i
1235     Ligne(20) = P(5, 0) : Ligne(21) = P(5, 1) : Ligne(22) = P(0, 0) : Ligne(23) = P(0, 1)
1236    
1237     MettreFI = False ' lorsque l'on sort on met une face interne
1238     Me.Flag = 2
1239     Case 2
1240     MettreFI = False ' Attention, peut planter à cause de ça.
1241     End Select
1242    
1243    
1244     ElseIf Left(Nomsection, 1) = "T" Or Nomsection = " Poutre en T générique" Then ' le T
1245     Select Case numero
1246     Case 1
1247     Dim P(8, 1) As Double
1248     Dim d As Double
1249     d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
1250    
1251    
1252     P(0, 0) = 0
1253     P(0, 1) = 0
1254 bournival 130 P(1, 0) = d
1255 bournival 40 P(1, 1) = -Poutre.GetD4 / 2.0R
1256     P(2, 0) = -(Poutre.GetD1 - Poutre.GetD5 - Poutre.GetD3)
1257     P(2, 1) = -Poutre.GetD4 / 2.0R
1258     P(3, 0) = P(2, 0)
1259     P(3, 1) = -Poutre.GetD2 / 2
1260     P(4, 0) = -Poutre.GetD1 + Poutre.GetD5
1261     P(4, 1) = P(3, 1)
1262     P(5, 0) = P(4, 0)
1263     P(5, 1) = -P(4, 1)
1264     P(6, 0) = P(3, 0)
1265     P(6, 1) = -P(3, 1)
1266     P(7, 0) = P(2, 0)
1267     P(7, 1) = -P(2, 1)
1268     P(8, 0) = P(1, 0)
1269     P(8, 1) = -P(1, 1)
1270    
1271 bournival 130 r(0) = P(0, 0) - 1000 * Epsilon
1272 bournival 40 r(1) = 0 : r(2) = 0
1273     Outils_Math.Rotation2D(pt3, r(0), r(1))
1274     r(0) += TranslationX
1275     r(1) += TranslationY
1276     r = Commun.TransfertSketchToModel(swSketch, r)
1277    
1278     pt3(0) -= TranslationX
1279     pt3(1) -= TranslationY
1280     pt3(0) /= longueur : pt3(1) /= longueur
1281     For i = 0 To 8
1282     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1283     P(i, 0) += TranslationX
1284     P(i, 1) += TranslationY
1285     Next i
1286    
1287     ReDim Ligne(35)
1288     For i = 0 To 7
1289     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)
1290     Next i
1291     Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
1292    
1293     Case 2
1294     Dim P(4, 1) As Double
1295     Dim d As Double
1296     d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
1297    
1298     P(0, 0) = 0
1299     P(0, 1) = 0
1300    
1301 bournival 130 P(1, 0) = d
1302 bournival 40 P(1, 1) = -Poutre.GetD4 / 2.0R
1303     P(2, 0) = Poutre.GetD5
1304     P(2, 1) = -Poutre.GetD4 / 2.0R
1305     P(3, 0) = P(2, 0)
1306     P(3, 1) = Poutre.GetD4 / 2
1307     P(4, 0) = P(1, 0)
1308     P(4, 1) = P(3, 1)
1309    
1310 bournival 130 r(0) = P(0, 0) + 1000 * Epsilon
1311 bournival 40 r(1) = 0 : r(2) = 0
1312     Outils_Math.Rotation2D(pt3, r(0), r(1))
1313     r(0) += TranslationX
1314     r(1) += TranslationY
1315     r = Commun.TransfertSketchToModel(swSketch, r)
1316    
1317     pt3(0) -= TranslationX
1318     pt3(1) -= TranslationY
1319     pt3(0) /= longueur : pt3(1) /= longueur
1320     For i = 0 To 4
1321     Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1322     P(i, 0) += TranslationX
1323     P(i, 1) += TranslationY
1324     Next i
1325    
1326     ReDim Ligne(19)
1327     For i = 0 To 3
1328     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)
1329     Next i
1330     Ligne(16) = P(4, 0) : Ligne(17) = P(4, 1) : Ligne(18) = P(0, 0) : Ligne(19) = P(0, 1)
1331    
1332     End Select
1333     MettreFI = True
1334    
1335    
1336     Else
1337     MsgBox("Section de poutre non reconnu!", MsgBoxStyle.Critical, "Commun.DessineSectionPoutre")
1338     End If
1339    
1340    
1341     If Not Ligne Is Nothing Then
1342     For i = 0 To UBound(Ligne) Step 4
1343     sketchline = swModel.CreateLine2(Ligne(i), Ligne(i + 1), 0, Ligne(i + 2), Ligne(i + 3), 0)
1344     Next i
1345     End If
1346    
1347     Return r
1348    
1349     End Function
1350    
1351 bournival 130 Public Function SwFace() As sldworks.Face2 ' retourne la première face de la liste (dans la partie traitement, ce sera la seule...)
1352 bournival 40 Return Me.lst_Faces.Item(0)
1353     End Function
1354    
1355 bournival 130 Public Function IsFaceInterne(ByRef swface As sldworks.Face2) As Boolean
1356     Dim attr As sldworks.Attribute
1357     Dim SwEnt As sldworks.Entity
1358 bournival 40 SwEnt = swface
1359     attr = SwEnt.FindAttribute(DefAttrFaceInterne, 0)
1360     If attr Is Nothing Then Return False Else Return True
1361     End Function
1362    
1363     ''' <summary>
1364     ''' Fonction qui retourne un tableau de Sldworks.edge (et non slyedges)
1365     ''' </summary>
1366     ''' <returns>Un tableau de Edges</returns>
1367     ''' <remarks></remarks>
1368 bournival 130 Public Function GetAretes() As sldworks.Edge()
1369     Dim face As sldworks.Face2
1370     Dim arete As sldworks.Edge = Nothing
1371     Dim temp2 As Collections.Generic.List(Of sldworks.Edge)
1372     Dim lst As New Collections.Generic.List(Of sldworks.Edge)
1373 bournival 40
1374     For Each face In Me.lst_Faces
1375     temp2 = GetArete1Face(face)
1376     For Each arete In temp2
1377     lst.Add(arete)
1378     Next arete
1379     Next face
1380    
1381     Return lst.ToArray
1382     End Function
1383    
1384 bournival 130 Private Function GetArete1Face(ByRef Face As sldworks.Face2) As Collections.Generic.List(Of sldworks.Edge)
1385 bournival 40 Dim vArete As Object
1386 bournival 130 Dim a As sldworks.Edge
1387     Dim arete() As sldworks.Edge
1388     Dim lst As New Collections.Generic.List(Of sldworks.Edge)
1389 bournival 40
1390     ReDim arete(Face.GetEdgeCount - 1)
1391     vArete = Face.GetEdges()
1392    
1393     For Each a In vArete
1394     lst.Add(a)
1395     Next
1396    
1397     Return lst
1398     End Function
1399    
1400     Public Overrides Sub Selectionner(Optional ByVal Mark As Integer = 0, Optional ByRef append As Boolean = True)
1401 bournival 130 Dim swent As sldworks.Entity
1402     Dim swface As sldworks.Face2
1403 bournival 40
1404     For Each swface In lst_Faces
1405     swent = swface
1406     swent.Select2(append, Mark)
1407     Next swface
1408     End Sub
1409    
1410    
1411     ''' <summary>
1412     ''' Sélectionne toutes les faces dans la liste de faces
1413     ''' </summary>
1414     ''' <param name="Mark"></param>
1415     ''' <param name="Append"></param>
1416     ''' <remarks></remarks>
1417     Public Sub SelectionnerToutes(Optional ByRef Mark As Integer = 0, Optional ByRef Append As Boolean = True)
1418 bournival 130 Dim swFace As sldworks.Face2
1419 bournival 40
1420 bournival 130 Dim swent As sldworks.Entity
1421 bournival 40 If Append = False Then swModel.ClearSelection2(True)
1422     For Each swFace In Me.lst_Faces
1423     swent = swFace : swent.Select2(True, Mark)
1424     Next
1425    
1426     End Sub
1427    
1428    
1429    
1430     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
1431     swModel.SelectedFaceProperties(RGB(rouge, Vert, Bleu), Ambient, Diffuse, Specular, Shininess, Transparency, Emission, False, "")
1432     Return 1
1433     End Function
1434    
1435    
1436 bournival 130 Public Sub AjouterFace(ByRef face As sldworks.Face2)
1437     Dim testface As sldworks.Face2
1438     Dim faultentity As sldworks.FaultEntity
1439     Dim swent As sldworks.Entity
1440    
1441 bournival 40 If Not Me.lst_Faces.Contains(face) Then Me.lst_Faces.Add(face)
1442    
1443     ' vérifier que les anciennes faces sont toujours ok...
1444 bournival 130 'For Each testface In Me.lst_Faces
1445     ' faultentity = testface.Check
1446     ' If Not faultentity.Count = 0 Then ' on a un problème avec la face....
1447     ' If lst_Faces.Contains(testface) Then
1448     ' Try
1449     ' lst_Faces.Remove(testface)
1450     ' Catch ex As Exception
1451 bournival 40
1452 bournival 130 ' End Try
1453     ' End If
1454 bournival 40
1455 bournival 130 'Dim i As Integer
1456     'For i = 0 To faultentity.Count - 1
1457     ' swent = faultentity.Entity(i)
1458     ' If Not swent Is Nothing Then
1459     ' swent.Select4(True, Nothing)
1460     ' End If
1461     ' Debug.Print(" Fault[" & i & "] = " & swent.errorCode(i))
1462     'Next i
1463     'End If
1464     'Next testface
1465    
1466    
1467 bournival 40 End Sub
1468    
1469    
1470     'Public Function DonnerFaces() As SldWorks.Face2()
1471     ' 'Dim temp() As SldWorks.Face2
1472     ' 'Dim i As Integer
1473    
1474     ' 'ReDim temp(lst_Faces.Count - 1)
1475    
1476     ' 'For i = 1 To lst_Faces.Count
1477     ' ' temp(i - 1) = lst_Faces.Item(i)
1478     ' 'Next
1479    
1480     ' Return lst_Faces.ToArray
1481     'End Function
1482    
1483    
1484    
1485     ''' <summary>
1486     ''' Function qui retourne un pointeur vers la face
1487     ''' </summary>
1488     ''' <returns></returns>
1489     ''' <remarks></remarks>
1490 bournival 130 Public Function GetFace() As sldworks.Face2
1491 bournival 40 Return Me.SwFace
1492     End Function
1493    
1494     ''' <summary>
1495     ''' Fonction qui redonne toutes les Faces contenues dans cette face
1496     ''' </summary>
1497     ''' <returns></returns>
1498     ''' <remarks></remarks>
1499 bournival 130 Public Function GetFaces() As sldworks.Face2()
1500 bournival 40 Return Me.lst_Faces.ToArray
1501     End Function
1502    
1503     ''' <summary>
1504     ''' Sub qui renvoie les coordonnées min et max des valeurs U et V
1505     ''' </summary>
1506     ''' <param name="Umin"></param>
1507     ''' <param name="UMax"></param>
1508     ''' <param name="VMin"></param>
1509     ''' <param name="VMax"></param>
1510     ''' <remarks></remarks>
1511     Public Sub UVMinMax(ByRef Umin As Double, ByRef UMax As Double, ByRef VMin As Double, ByRef VMax As Double)
1512     Dim vBounds As Object
1513     vBounds = SwFace.GetUVBounds()
1514    
1515     Umin = vBounds(0)
1516     UMax = vBounds(1)
1517    
1518     VMin = vBounds(2)
1519     VMax = vBounds(3)
1520     End Sub
1521    
1522     ''' <summary>
1523     ''' Calcule la position du point selon les U et V
1524     ''' </summary>
1525     ''' <param name="U"></param>
1526     ''' <param name="V"></param>
1527     ''' <param name="X"></param>
1528     ''' <param name="Y"></param>
1529     ''' <param name="Z"></param>
1530 bournival 130 ''' <returns>Vrai si le point est sur la face, faux sinon</returns>
1531 bournival 40 ''' <remarks>Retourne X, Y et Z même si le point n'est pas sur la face (mais sur la surface) </remarks>
1532     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
1533 bournival 130 Dim surf As sldworks.Surface
1534 bournival 40 Dim vEv As Object, vpoint As Object
1535     Dim P(2) As Double
1536    
1537     surf = SwFace.GetSurface()
1538    
1539     vEv = surf.Evaluate(U, V, 0, 0)
1540    
1541     X = vEv(0) : Y = vEv(1) : Z = vEv(2)
1542    
1543     vpoint = SwFace.GetClosestPointOn(X, Y, Z)
1544    
1545     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
1546    
1547     End Function
1548    
1549     ''' <summary>
1550     ''' Function qui calcule la normale d'une face au point X,Y,Z.
1551     ''' </summary>
1552     ''' <param name="X"></param>
1553     ''' <param name="Y"></param>
1554     ''' <param name="Z"></param>
1555     ''' <returns>Un tableau de 3 doubles correspondant à la normale</returns>
1556     ''' <remarks></remarks>
1557     Public Function Normale(ByRef X As Double, ByRef Y As Double, ByRef Z As Double) As Double()
1558 bournival 130 Dim surf As sldworks.Surface
1559 bournival 40 Dim vtemp As Object
1560     Dim temp() As Double
1561     Dim sens As Boolean
1562    
1563     surf = SwFace.GetSurface
1564     If surf.IsPlane Then vtemp = SwFace.Normal : temp = vtemp : Return temp ' si la face est plane alors c'est ok, sinon il faut travailler...
1565    
1566     vtemp = surf.EvaluateAtPoint(X, Y, Z)
1567     ReDim temp(2)
1568     ' la normale de la face pointe AWAY from the body
1569     sens = SwFace.FaceInSurfaceSense() 'TRUE if face normal and surface normal are in the opposite direction and FALSE if they are in the same direction
1570    
1571     If sens Then ' on doit inverser
1572     temp(0) = -vtemp(0) : temp(1) = -vtemp(1) : temp(2) = -vtemp(2)
1573     Else
1574     temp(0) = vtemp(0) : temp(1) = vtemp(1) : temp(2) = vtemp(2)
1575     End If
1576     Return temp
1577    
1578     End Function
1579    
1580 bournival 130 ''' <summary>
1581     ''' Met un attribut de face interne
1582     ''' </summary>
1583     ''' <param name="face">La face sur laquelle mettre l'attribut</param>
1584     ''' <param name="Valeur">La taille de maille suggérée</param>
1585     ''' <param name="poutre">Si vrai alors on a une poutre, sinon une coque</param>
1586     ''' <returns>Le numéro de l'attribut (si jamais c'est important)</returns>
1587     ''' <remarks>Attention au signe de la valeur</remarks>
1588     Public Function MettreAttributFaceInterne(ByRef face As sldworks.Face2, Optional ByRef Valeur As Double = 0, Optional ByVal poutre As Boolean = True) As Integer
1589 bournival 40 Dim no As Integer = 0
1590     Dim nom As String = "FaceInterne" & no
1591 bournival 130 Dim swent As sldworks.Entity
1592     Dim attr As sldworks.Attribute
1593     Dim p As sldworks.Parameter
1594 bournival 40
1595 bournival 130 swent = face 'Me.SwFace
1596    
1597 bournival 40 attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
1598 bournival 130 If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom, 0, 2) ' 0 = swThisconfig
1599 bournival 40 While attr Is Nothing
1600     no += 1
1601     nom = "FaceInterne" & CStr(no)
1602 bournival 130 attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom, 0, 2)
1603 bournival 40 End While
1604 bournival 130 p = attr.GetParameter("FI")
1605     p.SetDoubleValue(Valeur)
1606    
1607     p = attr.GetParameter("Po")
1608     If poutre Then
1609     p.SetDoubleValue(0) ' poutre
1610     Else
1611     p.SetDoubleValue(1) ' coque
1612     End If
1613    
1614    
1615 bournival 40 GererDossiers("FaceInternes", nom)
1616 bournival 130 Return no
1617     End Function
1618 bournival 40
1619 bournival 130 ''' <summary>
1620     ''' Si la face est une face interne,alors on écrit les points POG dans le fichier
1621     ''' </summary>
1622     ''' <remarks></remarks>
1623     Public Sub MettrePointSurPOG(ByVal fichier As System.IO.StreamWriter)
1624     ' 2 - Si la face a un attribut de faceInterne on:
1625     Dim ENG As Double = Commun.ÉcartNodal
1626     Dim EcartSouhaite As Double
1627     Dim ratio As Double
1628    
1629    
1630     If Me.PossedeAttributFaceInterne Then
1631     ' 2.1 Détermine l'écart nodal à cette face ( en fait, le ratio... )
1632    
1633     ' là on a 2 options,
1634     ' a) on utilise le rayon hydraulique: 4* Surface / Périmètre
1635     EcartSouhaite = Me.GrosseurMailleFaceInterne ' 4 * Me.Aire / Me.Perimetre
1636     ratio = EcartSouhaite / ENG
1637    
1638    
1639     If ratio > 0.75 Then ratio = 0.75 ' ?!? on s'assure d'avoir un minimum de rafinement...
1640     ' b) On analyse la tessellation et on prend la plus petite longueur de triangle...
1641    
1642     ' 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
1643     ' On va mettre des points sur le contour des faces. un point va automatiquement se retrouver au milieu
1644    
1645     Dim objArete As Object = Me.SwFace.GetEdges
1646     Dim points As New Collections.Generic.List(Of Point)
1647     Dim p As Point
1648     Dim x, y, z As Double
1649    
1650    
1651     For Each swArete As sldworks.Edge In objArete
1652     Dim e As New SuperArete(swArete, True)
1653     Dim LongueurArete As Double = e.Longueur
1654     Dim nbSeg As Integer = Int(LongueurArete / EcartSouhaite / 2) : If nbSeg < 2 Then nbSeg = 2
1655     Dim dt As Double = (e.GetTMax - e.GetTMin) / nbSeg
1656     Dim T As Double = e.GetTMin
1657    
1658    
1659     ' les points sur les arètes
1660    
1661     For s As Integer = 1 To nbSeg - 1
1662     T += dt
1663     e.Evaluer(T, x, y, z)
1664     p = New Point(x, y, z) : points.Add(p)
1665     Next s
1666    
1667    
1668    
1669     ' les points sur les sommets
1670     Dim swSommets() As sldworks.Vertex = Me.GetSommets
1671     Dim es As SuperSommet
1672     For Each sommet As sldworks.Vertex In swSommets
1673     es = New SuperSommet(sommet, True)
1674     p = New Point(es.X, es.Y, es.Z) : points.Add(p)
1675     Next
1676     e = Nothing
1677     es = Nothing
1678    
1679     Next
1680    
1681     For Each p In points
1682     ' 2.3 enregistre ces points dans le fichier.
1683     fichier.WriteLine(CStr(p) & " " & ratio & " " & "4" & " " & "0")
1684     Next p
1685     ENG = 1 ' pour y mettre un point d'arrêt
1686     End If
1687 bournival 40 End Sub
1688    
1689    
1690 bournival 130 ''' <summary>
1691     ''' Retourne un tableau de swSommets
1692     ''' </summary>
1693     ''' <returns></returns>
1694     ''' <remarks></remarks>
1695     Public Function GetSommets() As sldworks.Vertex()
1696     Dim lst_sommets As New Collections.Generic.List(Of sldworks.Vertex)
1697     Dim swSommet As sldworks.Vertex
1698     Dim objArete As Object = Me.SwFace.GetEdges()
1699    
1700     For Each arete As sldworks.Edge In objArete
1701     swSommet = arete.GetStartVertex() : If swSommet Is Nothing Then Continue For
1702     If Not lst_sommets.Contains(swSommet) Then lst_sommets.Add(swSommet)
1703     swSommet = arete.GetEndVertex()
1704     If Not lst_sommets.Contains(swSommet) Then lst_sommets.Add(swSommet)
1705     Next arete
1706     Return lst_sommets.ToArray
1707     End Function
1708    
1709    
1710     ''' <summary>
1711     ''' Function qui donne la grosseur des maille que l'on aimerait avoir pour
1712     ''' </summary>
1713     ''' <returns></returns>
1714     ''' <remarks></remarks>
1715     Public Function GrosseurMailleFaceInterne() As Double
1716     Dim swEnt As sldworks.Entity
1717     Dim attr As sldworks.Attribute
1718     swEnt = Me.SwFace
1719     attr = swEnt.FindAttribute(Intersections.DefAttrFaceInterne, 0)
1720     If attr Is Nothing Then Return Nothing
1721     Dim p As sldworks.Parameter = attr.GetParameter("FI")
1722     Return p.GetDoubleValue
1723     End Function
1724    
1725     ''' <summary>
1726     ''' Retourne vrai si la face a un attribut de face interne.
1727     ''' </summary>
1728     ''' <returns></returns>
1729     ''' <remarks></remarks>
1730     Public Function PossedeAttributFaceInterne() As Boolean
1731     Dim swEnt As sldworks.Entity
1732     Dim attr As sldworks.Attribute
1733     swEnt = Me.SwFace
1734     attr = swEnt.FindAttribute(Intersections.DefAttrFaceInterne, 0)
1735     If attr Is Nothing Then Return False Else Return True
1736     End Function
1737    
1738    
1739     ''' <summary>
1740     ''' Retourne le périmètre de la face
1741     ''' </summary>
1742     ''' <returns></returns>
1743     ''' <remarks>Attention, c'est une approximation!!!</remarks>
1744     Public Function Perimetre() As Double
1745     Dim objArete As Object = Me.SwFace.GetEdges
1746     'Dim swAretes() As sldworks.Edge = objArete
1747     Dim longueur As Double
1748    
1749     For Each swArete As sldworks.Edge In objArete
1750     Dim e As New SuperArete(swArete, True)
1751     longueur += e.Longueur()
1752     Next
1753     Return longueur
1754     End Function
1755    
1756    
1757     ''' <summary>
1758     ''' Retourne la surface (l'aire) de la face
1759     ''' </summary>
1760     ''' <returns></returns>
1761     ''' <remarks></remarks>
1762     Public Function Aire() As Double
1763     Return Me.SwFace.GetArea
1764     End Function
1765    
1766     ''' <summary>
1767     ''' Retourne le nombre d'arètes contenues dans la superface
1768     ''' </summary>
1769     ''' <value></value>
1770     ''' <returns></returns>
1771     ''' <remarks></remarks>
1772     Public ReadOnly Property GetNbAretes() As Integer
1773     Get
1774     Dim nb As Integer
1775     Dim lstFaces() As sldworks.Face2 = Me.SwFace
1776     For Each swFace As sldworks.Face2 In lstFaces
1777     nb += swFace.GetEdgeCount
1778     Next
1779     Return nb
1780     End Get
1781     End Property
1782    
1783     Public Function GetSurface() As sldworks.Surface
1784     Return Me.GetFace.GetSurface
1785     End Function
1786    
1787    
1788    
1789 bournival 40 End Class