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

File Contents

# User Rev Content
1 bournival 48 Imports SolidWorks.Interop
2     Imports SolidWorks.Interop.swconst
3     Imports SolidWorks.Interop.swpublished
4    
5 bournival 40 Module Intersections
6     Public DefAttrInterALAL As SldWorks.AttributeDef
7     Public DefAttrConditionLimite As SldWorks.AttributeDef
8     Public DefAttrRCP1 As SldWorks.AttributeDef
9     Public DefAttrRCCoque As SldWorks.AttributeDef
10     Public DefAttrFaceInterne As SldWorks.AttributeDef
11     Public DefAttrDoublon As SldWorks.AttributeDef
12     Public DefAttrIgnorer As SldWorks.AttributeDef
13    
14     Public nbMinipoutre As Long
15    
16 bournival 130 Public lst_InterCoqueCoque As New Collections.Generic.List(Of InterCoqueCoque)
17 bournival 40
18 bournival 130 Public MettreMiniPoutresSurFaceInternes As Boolean
19     Public MultiDecoupageCoques As Boolean = False
20 bournival 40
21     #Region "Enums"
22     Public Enum typeInterPoutreVolume
23     Centre = 0
24     Sur_arete = 1
25     Sur_sommet = 2
26     Courbe = 3
27     End Enum
28    
29     #End Region
30    
31    
32     Public Sub Debuter(Optional ByRef nom2 As String = "C:\Documents and Settings\Sylvain Bournival\Bureau\testMAGiC.sldprt", Optional ByVal nomFichier As String = "", Optional ByRef original As Boolean = True, Optional ByRef modifie As Boolean = True)
33    
34     ' *******
35     ' quelques options de performance
36     ' *******
37 bournival 48 swApp.SetUserPreferenceIntegerValue(swconst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 0)
38 bournival 40 swModel.SetAddToDB(True)
39     swModel.SetDisplayWhenAdded(False)
40 bournival 130 swModel.SetInferenceMode(False)
41 bournival 40 ' ******
42     ' fin des options de performance
43     ' ******
44    
45     Memoriser3iemePoint() ' mémorise le coord system car si on découpe, sa coordonnée est perdue.
46 bournival 130
47 bournival 40 CouperPoutres()
48     Commun.GenererListes() ' va ignorer les poutres à ignorer... et ajouter les poutres coupées dans la liste.
49    
50    
51    
52     ' Traitement des intersection poutres-Volumes
53 bournival 130 DetectionPoutresVolumes() ' doit être avant interpoutreCoque au cas où on aurait une poutre de section
54 bournival 40 DecouperPoutreVolume()
55     ' fin traitement intersection poutres-volumes
56    
57     swModel.EditRebuild3()
58    
59    
60    
61     ' Traitement des intersection entre poutre et coques
62     DetectionPoutresCoques()
63     DecouperPoutreCoque()
64     ' Fin du traitement des intersections entre poutre et coques
65    
66    
67     ' traitement des coques-volumes
68     DetectionCoqueVolume()
69     DécouperCoqueVolume()
70     ' fin traitement coque volume
71    
72     ' traitement des coques-coques
73     DetectionCoqueCoque()
74 bournival 46 DecouperCoqueCoque()
75 bournival 40 '
76    
77    
78    
79     ' *******
80     ' quelques options de performance, remettre à la position initiale
81     ' *******
82 bournival 48 swApp.SetUserPreferenceIntegerValue(swconst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 15)
83 bournival 40 swModel.SetAddToDB(False)
84     swModel.SetDisplayWhenAdded(True)
85     swModel.GraphicsRedraw2()
86 bournival 130 swModel.SetInferenceMode(True)
87 bournival 40 ' ******
88     ' fin des options de performance
89     ' ******
90     ReplacerFolder()
91    
92    
93     End Sub
94    
95    
96     ''' <summary>
97 bournival 46 ''' Sub qui découpe les coques en fonction des informations placées dans le InterCoqueCoque
98     ''' </summary>
99     ''' <remarks></remarks>
100     Private Sub DecouperCoqueCoque()
101     Dim rayon As Double
102    
103 bournival 130 For Each interCC As InterCoqueCoque In lst_InterCoqueCoque
104     'rayon = IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2.GetEpaisseur, interCC.sFaceCoque1.GetEpaisseur)
105 bournival 46
106 bournival 130 If interCC.DoitCouperCoque1 Then
107     rayon = interCC.sFaceCoque2.GetEpaisseur / 2
108     Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
109     interCC.DecouperCoque(interCC.sFaceCoque1, sweep)
110     If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque2, interCC.sFaceCoque1)
111     End If
112 bournival 46
113 bournival 130 If interCC.DoitCouperCoque2 Then
114     rayon = interCC.sFaceCoque1.GetEpaisseur / 2
115     Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
116     interCC.DecouperCoque(interCC.sFaceCoque2, sweep)
117     If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque1, interCC.sFaceCoque2)
118     End If
119    
120     If interCC.FaceAPlat Then
121     interCC.CoupeAPlat()
122     End If
123    
124     ' reste à retrouver les faces internes.
125     'interCC.MarquerFacesInternes(IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2, interCC.sFaceCoque1), IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque1, interCC.sFaceCoque2))
126 bournival 46 Next
127    
128    
129     End Sub
130    
131 bournival 130 'Private Sub DecouperCoqueCoque()
132     ' Dim rayon As Double
133    
134    
135     ' For Each Coque As SlyFaceCoque In Commun.lst_FaceCoque
136     ' For Each interCC As InterCoqueCoque In Coque.lst_InterCoqueCoque
137     ' rayon = IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2.GetEpaisseur, interCC.sFaceCoque1.GetEpaisseur)
138     ' Dim sweep As SldWorks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
139     ' interCC.DecouperCoque(Coque, sweep)
140    
141     ' ' reste à retrouver les faces internes.
142     ' interCC.MarquerFacesInternes(IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2, interCC.sFaceCoque1), IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque1, interCC.sFaceCoque2))
143     ' Next
144     ' Next
145    
146    
147     'End Sub
148    
149    
150    
151 bournival 46 ''' <summary>
152 bournival 40 ''' sub qui créé une instance de la classe interCoqueCoque s'il y a une intersection de ce type
153     ''' </summary>
154     ''' <remarks></remarks>
155     Private Sub DetectionCoqueCoque()
156    
157     Dim sketch As SldWorks.Sketch = Nothing
158     Dim interCC As InterCoqueCoque = Nothing
159 bournival 46 Dim Coque1 As SlyFaceCoque, Coque2 As SlyFaceCoque
160 bournival 40
161 bournival 46 For i As Integer = 0 To Commun.lst_FaceCoque.Count - 2 'For Each Coque1 As SlyFaceCoque In Commun.lst_FaceCoque
162     Coque1 = Commun.lst_FaceCoque.Item(i)
163     For j As Integer = i + 1 To Commun.lst_FaceCoque.Count - 1 ' For Each coque2 As SlyFaceCoque In lst_FaceCoque
164     Coque2 = Commun.lst_FaceCoque.Item(j)
165     If DetectFaceFace(Coque2.SwFace, Coque1.SwFace, True, sketch) Then
166 bournival 40 ' création de l'instance de interFace-face entre coque et coque
167    
168 bournival 130 interCC = New InterCoqueCoque(Coque1, Coque2)
169 bournival 40 interCC.FaceDeSection = False
170     interCC.sketch = sketch
171 bournival 130 interCC.determineType()
172     lst_InterCoqueCoque.Add(interCC)
173 bournival 40
174 bournival 130 'Coque1.lst_InterCoqueCoque.Add(interCC)
175     'Coque2.lst_InterCoqueCoque.Add(interCC)
176 bournival 40 End If
177    
178 bournival 46 Next j
179     Next i
180 bournival 40
181     End Sub
182    
183    
184     Private Sub ReplacerFolder()
185     ' on doit mettre les folders à la fin pour que ça marche dans MAGiC
186     'Si on ne met pas les attributs à la fin on est baisé...
187    
188     Dim swFeat As SldWorks.Feature = Nothing
189     Dim nomdernier As String
190     Dim dansFolder As Boolean = False
191     Dim i As Integer = 0
192     Dim ok As Boolean = False
193     Dim SelMgr As SldWorks.SelectionMgr
194    
195     'trouver le premier feature qui n'est pas un folder...
196     Do Until ok
197     swFeat = swModel.FeatureByPositionReverse(i)
198     nomdernier = swFeat.GetTypeName
199    
200     If (nomdernier = "FtrFolder") Then
201     dansFolder = Not dansFolder
202     Else
203     If Not dansFolder Then ok = True
204     End If
205     i += 1
206     Loop
207    
208     nomdernier = swFeat.Name
209    
210     SelMgr = swModel.SelectionManager
211     If swModel.Extension.SelectByID2("Poutres", "FTRFOLDER", 0, 0, 0, False, 0, Nothing, 0) Then swModel.ReorderFeature("Poutres", nomdernier)
212     If swModel.Extension.SelectByID2("Coques", "FTRFOLDER", 0, 0, 0, False, 0, Nothing, 0) Then swModel.ReorderFeature("Coques", nomdernier)
213     If swModel.Extension.SelectByID2("Conditions Aux Limites", "FTRFOLDER", 0, 0, 0, False, 0, Nothing, 0) Then swModel.ReorderFeature("Conditions Aux Limites", nomdernier)
214     If swModel.Extension.SelectByID2("FaceInternes", "FTRFOLDER", 0, 0, 0, False, 0, Nothing, 0) Then swModel.ReorderFeature("FaceInternes", nomdernier)
215    
216     End Sub
217    
218    
219     Public Sub RegisterAttribut()
220     Static nouveau As Boolean
221     'propriétés des intersections entre 2 poutres (Arete-libre Arête-libre)
222    
223     If nouveau Then Exit Sub
224     Dim nom As String
225     Dim retval As Boolean
226    
227     nom = "InterALAL"
228     DefAttrInterALAL = swApp.DefineAttribute(nom)
229 bournival 48 DefAttrInterALAL.AddParameter("X", swconst.swParamType_e.swParamTypeDouble, 0, 0)
230     DefAttrInterALAL.AddParameter("Y", swconst.swParamType_e.swParamTypeDouble, 0, 0)
231     DefAttrInterALAL.AddParameter("Z", swconst.swParamType_e.swParamTypeDouble, 0, 0)
232     DefAttrInterALAL.AddParameter("T", swconst.swParamType_e.swParamTypeDouble, -1, 0)
233 bournival 40 retval = DefAttrInterALAL.Register()
234     If retval = False Then MsgBox("Enregistrement raté pour le InterALAL")
235    
236    
237     nom = "ConditionLimite"
238     DefAttrConditionLimite = swApp.DefineAttribute(nom)
239 bournival 48 DefAttrConditionLimite.AddParameter("CL", swconst.swParamType_e.swParamTypeString, 0, 0)
240 bournival 40 retval = DefAttrConditionLimite.Register()
241     If retval = False Then MsgBox("Enregistrement raté pour le COndition Limite")
242    
243    
244     DefAttrRCP1 = swApp.DefineAttribute("Poutre1")
245     DefAttrRCP1.AddParameter("M", 1, 0, 0) ' 0 = double, 1 = string, 2 = integer
246     DefAttrRCP1.AddParameter("S", 1, 0, 0)
247     DefAttrRCP1.AddParameter("As", 0, 0, 0)
248     DefAttrRCP1.AddParameter("I1", 0, 0, 0)
249     DefAttrRCP1.AddParameter("I2", 0, 0, 0)
250     DefAttrRCP1.AddParameter("N3", 1, 0, 0) ' le nom du troisième point
251     DefAttrRCP1.AddParameter("X3", 0, 0, 0) ' le x du troisième point
252     DefAttrRCP1.AddParameter("Y3", 0, 0, 0) ' le y du troisième point
253     DefAttrRCP1.AddParameter("Z3", 0, 0, 0) ' le z du troisième point
254     DefAttrRCP1.AddParameter("D1", 0, 0, 0)
255     DefAttrRCP1.AddParameter("D2", 0, 0, 0)
256     DefAttrRCP1.AddParameter("D3", 0, 0, 0)
257     DefAttrRCP1.AddParameter("D4", 0, 0, 0)
258     DefAttrRCP1.AddParameter("D5", 0, 0, 0)
259     DefAttrRCP1.AddParameter("D6", 0, 0, 0)
260     DefAttrRCP1.AddParameter("Flag", 0, 0, 0)
261     retval = DefAttrRCP1.Register()
262     If retval = False Then MsgBox("Enregistrement raté pour le RCPoutre")
263    
264     DefAttrRCCoque = swApp.DefineAttribute("Coque")
265     DefAttrRCCoque.AddParameter("M", 1, 0, 0) 'le matériau' 0 = double, 1 = string, 2 = integer
266     DefAttrRCCoque.AddParameter("Ep", 0, 0, 0) ' épaisseur
267     DefAttrRCCoque.AddParameter("Flag", 0, 0, 0) ' un flag pour les coques...
268     retval = DefAttrRCCoque.Register()
269     If retval = False Then MsgBox("Enregistrement raté pour le RCCoque")
270    
271     DefAttrFaceInterne = swApp.DefineAttribute("FaceInterne")
272 bournival 130 DefAttrFaceInterne.AddParameter("FI", 0, 0, 0) ' la taille des éléments
273     DefAttrFaceInterne.AddParameter("Po", 0, 0, 0) ' =0 si poutre, =1 si coque
274 bournival 40 retval = DefAttrFaceInterne.Register()
275     If retval = False Then MsgBox("Enregistrement raté pour le FaceInterne")
276    
277     DefAttrDoublon = swApp.DefineAttribute("Doublon")
278     DefAttrDoublon.AddParameter("Maitre", 1, 0, 0) ' le nom du maitre...
279     DefAttrDoublon.AddParameter("Sens", 0, 0, 0) ' -1 si dans le sens oposé
280     retval = DefAttrDoublon.Register()
281     If retval = False Then MsgBox("Enregistrement raté pour le Doublon")
282    
283     nom = "Ignorer"
284     DefAttrIgnorer = swApp.DefineAttribute(nom)
285     DefAttrIgnorer.AddParameter("Rien", 0, 0, 0)
286     retval = DefAttrIgnorer.Register()
287     If retval = False Then MsgBox("Enregistrement raté pour le Ignorer")
288    
289     nouveau = True
290    
291     End Sub
292    
293     Private Sub TraiteAPAP()
294     ' procédure plus utilisée.
295     ' procédure qui trouve les intersections entre les poutres et qui créé un attribut contenant les informations
296    
297     ' en premier on efface les features attributs, pour ne pas avoir de doubles
298     Dim feat As SldWorks.Feature
299     feat = swPart.FirstFeature
300     Dim nextfeat As SldWorks.Feature
301    
302     Do While Not feat Is Nothing
303     If Left(feat.Name, 9) = "InterAPAP" Then
304     nextfeat = feat.GetNextFeature
305     swModel.Extension.SelectByID2(feat.Name, "ATTRIBUTE", 0, 0, 0, False, 0, Nothing, 0)
306     swPart.EditDelete()
307     feat = nextfeat
308     Else
309     feat = feat.GetNextFeature
310     End If
311     Loop
312     ' faut aussi détruire les liste de points dans les poutres
313     ' ce qui suit n'est pas optimisé en temps d'exécution, mais en temps de programmation ;-)
314     ' j'aurais besoin d'un trouver qui retourne le sly... en fonction d'un feature(edge)
315     Dim p As SlyAretePoutre
316     For Each p In lst_AretePoutre
317     p.EffacerIntersection()
318     Next
319    
320    
321     ' ' fin de l'effacement des attributs
322     Dim swArete1 As SldWorks.Edge
323     Dim swArete2 As SldWorks.Edge
324     Dim SlyArete1 As SlyAretePoutre
325     Dim SlyArete2 As SlyAretePoutre
326    
327     Dim xyz() As Double = Nothing
328     Dim pt As New InterPoutrePoutre
329     'Dim lst_pts As New Collection
330     Dim i As Long
331    
332     Dim a1 As Integer
333     Dim a2 As Integer
334    
335    
336     For a1 = 0 To lst_AretePoutre.Count - 2
337     SlyArete1 = lst_AretePoutre.Item(a1)
338     swArete1 = SlyArete1.swArete
339    
340     For a2 = a1 + 1 To lst_AretePoutre.Count - 1
341     SlyArete2 = lst_AretePoutre.Item(a2)
342     swArete2 = SlyArete2.swArete
343    
344     If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
345     For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
346    
347     Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
348     Case 1 ' la première courbe est coupée
349     pt = New InterPoutrePoutre
350     pt.Arete = swArete1
351     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
352     SlyArete1.AjouterPointAPAP(pt)
353     pt = Nothing
354     Case 2 ' la seconde courbe est coupée
355     pt = New InterPoutrePoutre
356     pt.Arete = swArete2
357     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
358     SlyArete2.AjouterPointAPAP(pt)
359     pt = Nothing
360     Case 3 ' les doux courbes sont coupées
361     pt = New InterPoutrePoutre
362     pt.Arete = swArete1
363     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
364     SlyArete1.AjouterPointAPAP(pt)
365     pt = Nothing
366     pt = New InterPoutrePoutre
367     pt.Arete = swArete2
368     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
369     SlyArete2.AjouterPointAPAP(pt)
370     pt = Nothing
371     End Select
372     Next i
373     End If
374    
375     Next a2
376     Next a1
377     pt = Nothing
378     End Sub
379    
380    
381     Public Function DetectAreteArete(ByRef swArete1 As SldWorks.Edge, ByRef swArete2 As SldWorks.Edge, ByRef xyz() As Double) As Boolean
382     ' function qui détermine si 2 arêtes se touchent, si oui alors la fonction retourne vrai et le tableau XYZ contient le point d'intersection
383     xyz = Nothing
384     If swArete2 Is Nothing Then Exit Function
385     If swArete1 Is Nothing Then Exit Function
386    
387     Dim swSommet As SldWorks.Vertex
388     Dim point1 As Object ' point début courbe 1
389     Dim point2 As Object ' point fin, courbe 1
390     Dim point3 As Object ' point début courbe 2
391     Dim point4 As Object ' point fin, courbe 2
392     Dim swCourbe1 As SldWorks.Curve
393     Dim swCourbe2 As SldWorks.Curve
394     Dim vIntersectPts As Object
395    
396     swSommet = swArete1.GetStartVertex
397     If swSommet Is Nothing Then ' cercle fermé
398     point1 = swArete1.Evaluate(0)
399     point2 = point1
400     Else
401     point1 = swSommet.GetPoint
402     swSommet = swArete1.GetEndVertex
403     point2 = swSommet.GetPoint
404     End If
405    
406     swSommet = swArete2.GetStartVertex
407     If swSommet Is Nothing Then
408     point3 = swArete2.Evaluate(0)
409     point4 = point3
410     Else
411     point3 = swSommet.GetPoint
412    
413     swSommet = swArete2.GetEndVertex
414     point4 = swSommet.GetPoint
415     End If
416     swCourbe1 = swArete1.GetCurve
417     swCourbe2 = swArete2.GetCurve
418    
419    
420     vIntersectPts = swCourbe1.IntersectCurve(swCourbe2, point1, point2, point3, point4)
421    
422     Try ' je déteste cette façon de procéder, mais il ne détecte pas que le vintersectpts est nothing, il le croit system.dbnull. Et je ne peut comparer avec ça.
423     xyz = vIntersectPts
424    
425     If Not xyz Is Nothing Then
426     DetectAreteArete = True
427     Dim i As Integer
428     For i = 0 To ((UBound(xyz) + 1) / 4) - 1
429     Debug.Write("x" & i & " = " & xyz(i * 4) * 1000 & " mm")
430     Debug.Write("y" & i & " = " & xyz(i * 4) * 1000 & " mm")
431     Debug.Write("z" & i & " = " & xyz(i * 4) * 1000 & " mm")
432     Next i
433     Else
434     Return False
435     End If
436     Catch ex As Exception
437     DetectAreteArete = False
438     End Try
439    
440     End Function
441    
442     Public Function DetectAreteArete(ByRef swArete1 As SldWorks.Edge, ByRef swCourbe2 As SldWorks.Curve, ByRef xyz() As Double) As Boolean
443     ' function qui détermine si 2 arêtes se touchent, si oui alors la fonction retourne vrai et le tableau XYZ contient le point d'intersection
444     xyz = Nothing
445     If swArete1 Is Nothing Then Exit Function
446     Dim swSommet As SldWorks.Vertex
447     Dim point1 As Object ' point début courbe 1
448     Dim point2 As Object ' point fin, courbe 1
449     Dim point3 As Object ' point début courbe 2
450     Dim point4 As Object ' point fin, courbe 2
451     Dim swCourbe1 As SldWorks.Curve
452    
453     Dim vIntersectPts As Object
454    
455     swSommet = swArete1.GetStartVertex
456     If swSommet Is Nothing Then ' cercle fermé
457     point1 = swArete1.Evaluate(0)
458     point2 = point1
459     Else
460     point1 = swSommet.GetPoint
461     swSommet = swArete1.GetEndVertex
462     point2 = swSommet.GetPoint
463     End If
464    
465    
466    
467     If Not swCourbe2.IsTrimmedCurve Then
468     Dim vP1 As Object, vP2 As Object
469     vP1 = swCourbe2.Evaluate(-9000)
470     vP2 = swCourbe2.Evaluate(9000)
471     swCourbe2 = swCourbe2.CreateTrimmedCurve2(vP1(0), vP1(1), vP1(2), vP2(0), vP2(1), vP2(2))
472     End If
473    
474     If Not swCourbe2.IsTrimmedCurve Then
475     MsgBox("Ça plante, le trimmage n'a pas fonctionné...")
476     End If
477    
478     Dim dpoint3 As Double, dpoint4 As Double, isClosed As Boolean, isPeriodic As Boolean
479     swCourbe2.GetEndParams(dpoint3, dpoint4, isClosed, isPeriodic)
480    
481     point3 = swCourbe2.Evaluate(dpoint3)
482     point4 = swCourbe2.Evaluate(dpoint4)
483    
484     swCourbe1 = swArete1.GetCurve
485    
486     vIntersectPts = swCourbe1.IntersectCurve(swCourbe2, point1, point2, point3, point4)
487    
488     Try ' je déteste cette façon de procéder, mais il ne détecte pas que le vintersectpts est nothing, il le croit system.dbnull. Et je ne peut comparer avec ça.
489     xyz = vIntersectPts
490    
491     If Not xyz Is Nothing Then
492     DetectAreteArete = True
493     Dim i As Integer
494     For i = 0 To ((UBound(xyz) + 1) / 4) - 1
495     Debug.Write("x" & i & " = " & xyz(i * 4) * 1000 & " mm")
496     Debug.Write("y" & i & " = " & xyz(i * 4) * 1000 & " mm")
497     Debug.Write("z" & i & " = " & xyz(i * 4) * 1000 & " mm")
498     Next i
499     Else
500     Return False
501     End If
502     Catch ex As Exception
503     DetectAreteArete = False
504     End Try
505    
506     End Function
507    
508     Private Function isIntersect_milieu(ByRef Arete1 As SldWorks.Edge, ByRef Arete2 As SldWorks.Edge, ByRef x As Double, ByRef y As Double, ByRef z As Double) As Byte
509     'procédure qui dit si les courbes s'intersectent au milieu ou à leurs point d'extrémité.
510     ' 0 si les deux intersections sont sur des points
511     ' 1 si la première courbe est coupée
512     ' 2 si la deuxième est coupée
513     ' 3 si les deux courbes sont coupées
514    
515    
516     Dim retv As Object ' mettre les valeurs de T dans la classe
517    
518     retv = Arete1.GetCurveParams2() ' retv 0,1,2 point de départ, 3,4,5 point final
519     If (Math.Abs(retv(0) - x) < Epsilon) And (Math.Abs(retv(1) - y) < Epsilon) And (Math.Abs(retv(2) - z) < Epsilon) Or (Math.Abs(retv(3) - x) < Epsilon) And (Math.Abs(retv(4) - y) < Epsilon) And (Math.Abs(retv(5) - z) < Epsilon) Then isIntersect_milieu = 0 Else isIntersect_milieu = 1
520    
521     retv = Arete2.GetCurveParams2() ' retv 0,1,2 point de départ, 3,4,5 point final
522     If (Math.Abs(retv(0) - x) < Epsilon) And (Math.Abs(retv(1) - y) < Epsilon) And (Math.Abs(retv(2) - z) < Epsilon) Or (Math.Abs(retv(3) - x) < Epsilon) And (Math.Abs(retv(4) - y) < Epsilon) And (Math.Abs(retv(5) - z) < Epsilon) Then isIntersect_milieu += 0 Else isIntersect_milieu += 2
523    
524     End Function
525    
526    
527     ''' <summary>
528     ''' Sub qui traite les intersections entre les Poutres et les coques
529     ''' </summary>
530     ''' <remarks></remarks>
531     Private Sub DetectionPoutresCoques()
532     '#1 on détecte les intersections, on en a 4 types,
533     ' #1a) intersection au milieu de la coque
534     ' #1b) intersection sur une arête
535     ' #1c) intersection sur un sommet
536     ' #1d) intersection sur une certaine longueur
537     ' faut également faire attention, il peut y avoir plus d'une poutre qui se rejoint à la même intersection.
538     ' hypothèses: 1- les zones d'influence des poutres ne se croisent pas.
539     ' 2- une arête ne fait qu'une seule intersection, à un pount ou sur une ligne, mais pas à plusieurs endroits.
540     ' 3- une arête dont l'intersection est une courbe n'a pas d'autres intersections (pout l'instant)
541     ' lorsqu'une intersection est détectée on créé une instance de la classe InterPoutreCoque
542    
543     Dim sPoutre As SlyAretePoutre
544     Dim sCoque As SlyFaceCoque
545     Dim inter As InterPoutreCoque
546     Dim xyz() As Double = Nothing
547     Dim tipe As Byte
548     Dim i As Integer
549     Dim premier2 As Boolean
550    
551    
552     For Each sCoque In lst_FaceCoque
553     For Each sPoutre In lst_AretePoutre
554     ' on cherche entre la coque et la poutre
555    
556     If DetectFaceArete(sPoutre.swArete, sCoque.SwFace, xyz) Then
557     For i = 0 To UBound(xyz) - 1 Step 3
558     ' trouver le tipe d'intersection...
559    
560     Dim u() As Double
561     Dim v() As Double
562    
563     u = sPoutre.GetOrientation(xyz(i + 0), xyz(i + 1), xyz(i + 2))
564     v = sCoque.GetNormale(xyz(i + 0), xyz(i + 1), xyz(i + 2))
565    
566     If Math.Abs((Math.Abs(Math.Acos(Outils_Math.cosdir(u, v))) - Pi / 2)) < Epsilon Then
567     ' on est dans le même plan que la coque, on doit déterminer si on sort ou entre dans la coque.
568     Dim T As Double, T1 As Double, T2 As Double
569     Dim PointTest(2) As Double
570     T = sPoutre.GetT(xyz(i + 0), xyz(i + 1), xyz(i + 2))
571    
572     ' on fait T + ou - 15 * epsilon. si une valeur est dans la coque alors on considère que l'on a le type 2
573     ' on prend 15 fois epsilon car à 10, la fonction de solidworks considère que l'on est tellement près que l'on est sur la face
574     T1 = T + 15 * Epsilon
575     T2 = T - 15 * Epsilon
576    
577     Dim effacer As Double
578    
579     If sPoutre.Evaluer(T1, PointTest) Then
580     ' la valeur de T appartient à la poutre, maintenant on vérifie s'il appartient aussi à la coque
581 bournival 130 If Distance(sCoque.lst_Faces.Item(0), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
582 bournival 40 ' on est dans la coque.
583     If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
584     End If
585     End If
586    
587     If sPoutre.Evaluer(T2, PointTest) Then
588     effacer = Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2))
589     If Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
590     If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
591     End If
592     End If
593    
594    
595     ' si tipe n'est pas à 2 alors on est par défaut à 3
596     If tipe = 0 Then tipe = 3
597    
598     Else
599     tipe = 1 ' on va devoir couper en X
600     End If
601    
602     inter = sCoque.AjouterInterPoutre(sPoutre, xyz, tipe)
603     sPoutre.lst_InterCoque.Add(inter)
604     tipe = 0 ' reset
605    
606     Next i ' autre point d'intersection
607    
608     End If
609     premier2 = False ' reset
610     Next sPoutre
611     Next sCoque
612     End Sub
613    
614    
615    
616     ''' <summary>
617     ''' Sub qui procède au découpage des coques en fonction des poutres
618     ''' </summary>
619     ''' <remarks></remarks>
620     Private Sub DecouperPoutreCoque()
621     ' #2 on procède au découpage de la face
622     Dim sCoque As SlyFaceCoque
623     For Each sCoque In lst_FaceCoque
624     If sCoque.lst_InterPoutre.Count > 0 Then
625     'sVol.chercherAttributs()
626     sCoque.decouper()
627    
628     ' on met-a-jour l'attribut des conditions aux limites
629     Dim attr As SldWorks.Attribute
630     Dim swent As SldWorks.Entity
631     Dim nom3 As String = Nothing
632     Dim p As SldWorks.Parameter
633     If Not sCoque.AttributCL Is Nothing Then
634     nom3 = "CL_" & sCoque.nom
635     swent = sCoque.lst_Faces.Item(1)
636     attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
637    
638     If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, sCoque.lst_Faces.Item(1), nom3, 0, 0)
639     p = attr.GetParameter("CL")
640     p.SetStringValue(sCoque.condition)
641    
642     End If
643     GererDossiers("Conditions Aux Limites", nom3)
644     End If
645    
646     Next
647     End Sub
648    
649    
650     ''' <summary>
651     ''' Sub qui détecte les intersections entre les faces du volume et les poutres
652     ''' </summary>
653     ''' <remarks></remarks>
654     Private Sub DetectionPoutresVolumes()
655     Dim sPoutre As SlyAretePoutre
656    
657     For Each sPoutre In lst_AretePoutre
658     If Not sPoutre.IsFaceDeSection Then
659     Call Intersections.GestionPoutreNormaleAvecVolume(sPoutre)
660     Else
661     ' la poutre est flaggée pour prendre la face de section
662     Call Intersections.GestionFace_De_section(sPoutre)
663     End If
664     Next sPoutre
665     End Sub
666    
667     ''' <summary>
668     ''' Sub qui prend les intersections entre les faces et les volumes et qui coupe les volumes
669     ''' </summary>
670     ''' <remarks></remarks>
671     Private Sub DecouperPoutreVolume()
672     ' #2 on procède au découpage de la face
673     Dim sVol As SlyFaceVolume
674    
675     For Each sVol In lst_FaceVolume
676     If sVol.lst_InterPoutre.Count > 0 Then
677     sVol.decouper()
678    
679     ' on met-a-jour l'attribut des conditions aux limites
680     Dim attr As SldWorks.Attribute
681     Dim swent As SldWorks.Entity
682     Dim nom3 As String = Nothing
683     Dim p As SldWorks.Parameter
684     If Not sVol.AttributCL Is Nothing Then
685     nom3 = "CL_" & sVol.nom
686     swent = sVol.SwFace
687     attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
688    
689     If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, sVol.SwFace, nom3, 0, 0)
690     p = attr.GetParameter("CL")
691     p.SetStringValue(sVol.condition)
692    
693     End If
694     GererDossiers("Conditions Aux Limites", nom3)
695     End If
696    
697     Next
698     End Sub
699    
700    
701    
702    
703    
704     ''' <summary>
705     ''' Sub qui gère la poutre qui a été flaggée comme ayant une face de section. Met à jour les attributs avec les bonnes inerties et autre
706     ''' </summary>
707     ''' <param name="sPoutre">La poutre avec laquelle il faut travailler</param>
708     ''' <remarks></remarks>
709     Private Sub GestionFace_De_section(ByRef sPoutre As SlyAretePoutre)
710    
711     Dim sVol As SlyFaceVolume
712     Dim swExt As SldWorks.ModelDocExtension
713     Dim xyz() As Double = Nothing, xyz2() As Double = Nothing
714     Dim section As Object
715     Dim Face1 As SlyFaceVolume = Nothing, prop1() As Double = Nothing
716     Dim Face2 As SlyFaceVolume = Nothing, prop2() As Double = Nothing
717     Dim proprietes() As Double
718     Dim i As Integer
719     swExt = swModel.Extension
720    
721     ' 1 - Spotter la ou les faces en question
722     xyz = sPoutre.GetStartPoint
723     xyz2 = sPoutre.GetEndPoint
724 bournival 130
725 bournival 40 For Each sVol In Commun.lst_FaceVolume
726     If Intersections.DetectSurfaceArete(sPoutre.swArete, sVol.SwFace, Nothing) Then
727     swModel.ClearSelection2(True)
728     sVol.Selectionner()
729     section = swExt.GetSectionProperties2(sVol.SwFace) : proprietes = section
730     swModel.ClearSelection2(True)
731 bournival 130 ' la fonction getsectionproperties renvoie des valeurs dont la précision est très douteuse...
732 bournival 40 ' on met alors une beaucoup plus grosse tolérance...
733 bournival 130 If Math.Abs(xyz(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz(2) - proprietes(4)) < 0.0001 Then
734     Face1 = sVol : prop1 = proprietes
735     ElseIf Math.Abs(xyz2(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz2(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz2(2) - proprietes(4)) < 0.0001 Then
736     Face2 = sVol : prop2 = proprietes
737     Else
738     ' on a une intersection où la poutre touche à une face «guide» et une autre partie touche à une face normale
739     ' la face est automatiquement une face de volume. Si c'est une coque, elle est traitée ailleurs.
740    
741     'Dim interNormale As InterPoutreVolume
742     'Dim point1 As Object = Nothing
743     'swModel.ClosestDistance(sPoutre.swArete, sVol.SwFace, point1, Nothing)
744     'Dim xyzNormale() As Double = point1
745     'interNormale = sVol.AjouterInterPoutre(sPoutre, xyzNormale, 6) ' y'a des cas où ça pourrait ne pas être 1...
746     'sPoutre.lst_InterCoque.Add(interNormale)
747    
748     End If
749    
750 bournival 40 End If
751     Next
752    
753     ' si les 2 faces sont nothing, c'est que l'on a un sérieux problème...
754     If Face1 Is Nothing AndAlso Face2 Is Nothing Then
755     MsgBox("La poutre " & sPoutre.nom & " doit avoir au moins une face pour évaluer sa section. Cette face n'a pas été trouvée." & vbCr & vbCr & " Vérifiez que: " & vbCr & " - Un sommet de la poutre repose sur le centre de gravité d'une face" & vbCr & " - Que l'arète de la poutre est perpendiculaire à la face" & vbCr & " - Que la face est plane " & vbCr & " - Je crois avoir tout couvert..." & vbCr & vbCr & " La poutre a problème a été colorée en rouge.", MsgBoxStyle.Critical, "Impossible de trouver la face représentant la section")
756     Dim e As New SuperArete(sPoutre.swArete, True)
757     e.Colorer(3, 1, 0, 0)
758     sPoutre.Selectionner()
759 bournival 130 Err.Raise(520, "Gestion_Face_De_Section", "Une poutre ne peut être traitée car elle n'a pas été correctement définie.")
760 bournival 40 Exit Sub
761     End If
762    
763    
764    
765     ' 2 - s'assurer que:
766     ' 2.1 les 2 faces sont identiques (si 2 faces)
767     If Face1 IsNot Nothing And Face2 IsNot Nothing Then
768     If Not Math.Abs(prop1(1) - prop2(1)) < 0.0000001 Then
769     Dim chaine As String
770     chaine = "Les 2 faces ne sont pas identiques... "
771     For i = 0 To 14
772     chaine = chaine & vbCr & i & " - " & Format(prop1(i), "0.000E+00") & " " & Format(prop2(i), "0.000E+00")
773     Next i
774     MsgBox(chaine)
775     End If
776     End If
777     ' 2.2 le centroide est au point d'intersection
778     ' déjà fait
779     ' 2.3 la face est plane
780 bournival 130 Dim prop() As Double = Nothing
781    
782 bournival 40 If Face1 IsNot Nothing Then
783 bournival 130 prop = prop1
784 bournival 40 If Not (Face1.estPlan Xor Face1.estFauxPlan(prop1(2), prop1(3), prop1(4))) Then
785     MsgBox("La face 1 n'est pas plane!")
786     Err.Raise(513, , "Ne peut pas prendre une face non plane comme source de la section de la poutre")
787     End If
788     End If
789     If Face2 IsNot Nothing Then
790 bournival 130 prop = prop2
791     If Not (Face2.estPlan Xor Face2.estFauxPlan(prop2(2), prop2(3), prop2(4))) Then
792 bournival 40 MsgBox("La face 2 n'est pas plane!")
793     Err.Raise(513, , "Ne peut pas prendre une face non plane comme source de la section de la poutre")
794     End If
795     End If
796    
797    
798     ' 2.4 les face sont perpendiculaire aux point d'intersection
799     Dim u() As Double
800     Dim v() As Double
801     Dim angle As Double
802     If Face1 IsNot Nothing Then
803     u = Face1.GetNormaleSurface(prop1(2), prop1(3), prop1(4))
804     v = sPoutre.GetOrientation(prop1(2), prop1(3), prop1(4))
805     angle = Outils_Math.Angle2Vecteurs(u, v)
806     If Not (Math.Abs(angle - Pi) < (100 * Epsilon)) And Not (angle < 0.005) Then
807     MsgBox("La poutre n'est pas perpendiculaire à la face1")
808     Err.Raise(514, "GestionFace_de_section - Dans intersection.vb", "Ne peut pas traiter une poutre dont la face de base n'est pas perpendiculaire")
809     End If
810     End If
811    
812     If Face2 IsNot Nothing Then
813     u = Face2.GetNormaleSurface(prop2(2), prop2(3), prop2(4))
814     v = sPoutre.GetOrientation(prop2(2), prop2(3), prop2(4))
815     angle = Outils_Math.Angle2Vecteurs(u, v)
816     If Not (Math.Abs(angle - Pi) < (100 * Epsilon)) And Not (angle < Epsilon) Then
817     MsgBox("La poutre n'est pas perpendiculaire à la face2")
818     Err.Raise(514, "GestionFace_de_section - Dans intersection.vb", "Ne peut pas traiter une poutre dont la face de base n'est pas perpendiculaire")
819     End If
820     End If
821    
822     ' 3 - trouver l'inertie et l'aire, placer le point 3 de façon cohérente, updater l'attribut.
823     Dim Nom3 As String
824    
825 bournival 130 Commun.MettreUnPoint(prop(2) + prop(18) / 1000, prop(3) + prop(19) / 1000, prop(4) + prop(20) / 1000, True)
826     Dim selmgr As sldworks.SelectionMgr = swModel.SelectionManager
827     Nom3 = RealConstant.RCCode.Creation3iemePoint(selmgr.GetSelectedObject(1))
828     sPoutre.SetAttributsDePoutre(False, Nom3, , , prop(13), prop(14), prop(1), , , , , , , 1)
829 bournival 40
830     ' 4 créer une nouvelle instance de la classe interFacePoutre de tipe 5
831     Dim inter As New InterPoutreVolume
832     Dim inter2 As New InterPoutreVolume
833     If Face1 IsNot Nothing Then
834     xyz(0) = prop1(2) : xyz(1) = prop1(3) : xyz(2) = prop1(4)
835     inter = Face1.AjouterInterPoutre(sPoutre, xyz, 5)
836     sPoutre.lst_InterCoque.Add(inter)
837     End If
838    
839     If Face2 IsNot Nothing Then
840     xyz(0) = prop2(2) : xyz(1) = prop2(3) : xyz(2) = prop2(4)
841     inter2 = Face2.AjouterInterPoutre(sPoutre, xyz, 5)
842     sPoutre.lst_InterCoque.Add(inter2)
843     End If
844    
845     End Sub
846    
847    
848     ''' <summary>
849     ''' Sub qui trouve les intersections entre les poutres et les faces de volumes et qui créé une instance de la classe d'intersection
850     ''' </summary>
851     ''' <param name="sPoutre">La poutre avec laquelle il faut trouver les intersections</param>
852     ''' <remarks></remarks>
853     Private Sub GestionPoutreNormaleAvecVolume(ByRef sPoutre As SlyAretePoutre)
854     Dim inter As InterPoutreVolume
855     Dim xyz() As Double = Nothing
856     Dim tipe As Byte
857     Dim i As Integer
858     Dim premier2 As Boolean
859     Dim sVol As SlyFaceVolume
860 bournival 130 Dim SurSurface As Boolean = False
861 bournival 40
862     For Each sVol In lst_FaceVolume
863    
864     ' on cherche entre la coque et la poutre
865 bournival 130 SurSurface = False
866     If DetectFaceArete(sPoutre.swArete, sVol, xyz, SurSurface) Then
867 bournival 40 For i = 0 To UBound(xyz) - 1 Step 3
868     ' trouver le tipe d'intersection...
869    
870     Dim u() As Double
871     Dim v() As Double
872    
873     u = sPoutre.GetOrientation(xyz(i + 0), xyz(i + 1), xyz(i + 2))
874     v = sVol.GetNormale(xyz(i + 0), xyz(i + 1), xyz(i + 2))
875    
876     ' ***** ici, différencier entre coque et volume ****
877     If Math.Abs((Math.Abs(Math.Acos(Outils_Math.cosdir(u, v))) - Pi / 2)) < Epsilon Then
878     ' on est dans le même plan que la coque, on doit déterminer si on sort ou entre dans la coque.
879     Dim T As Double, T1 As Double, T2 As Double
880     Dim PointTest(2) As Double
881     T = sPoutre.GetT(xyz(i + 0), xyz(i + 1), xyz(i + 2))
882    
883     ' on fait T + ou - 15 * epsilon. si une valeur est dans la coque alors on considère que l'on a le type 2
884     ' on prend 15 fois epxilon car à 10, la fonction de solidworks considère que l'on est tellement près que l'on est sur la face
885     T1 = T + 15 * Epsilon
886     T2 = T - 15 * Epsilon
887    
888    
889     If sPoutre.Evaluer(T1, PointTest) Then
890     ' la valeur de T appartient à la poutre, maintenant on vérifie s'il appartient aussi à la coque
891     If Distance(sVol.SwFace, PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
892     ' on est dans la coque.
893     If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
894     End If
895     End If
896    
897     If sPoutre.Evaluer(T2, PointTest) Then
898 bournival 130
899 bournival 40 If Distance(sVol.SwFace, PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
900     If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
901     End If
902     End If
903    
904     ' si tipe n'est pas à 2 alors on est par défaut à 3
905     If tipe = 0 Then tipe = 3
906    
907     Else
908     tipe = 1 ' on va devoir couper en X
909     End If
910    
911     inter = sVol.AjouterInterPoutre(sPoutre, xyz, tipe)
912     sPoutre.lst_InterCoque.Add(inter)
913     tipe = 0 ' reset
914    
915     Next i ' autre point d'intersection
916    
917 bournival 130 ElseIf SurSurface = True Then
918     ' Si les 2 points de la courbe touchent à la surface alors coupe-long
919     If Commun.Distance(sVol.SwFace, sPoutre.GetStartPoint()) < Epsilon AndAlso Commun.Distance(sVol.SwFace, sPoutre.GetEndPoint()) < Epsilon Then
920     inter = sVol.AjouterInterPoutre(sPoutre, xyz, 2)
921     sPoutre.lst_InterCoque.Add(inter)
922     End If
923 bournival 40 End If
924     premier2 = False ' reset
925    
926     Next sVol
927     End Sub
928    
929    
930    
931    
932     'Private Function DetectFaceArete(ByRef swCurve As SldWorks.Curve, ByRef swFace As SldWorks.Face2, ByRef xyz() As Double) As Boolean
933     ' ' function qui détecte si une arête coupe une face, si c'est le cas la function retourne true et remplie le tableau xyz avec le point d'intersection
934     ' Dim vCurveParam As Object
935     ' Dim swSurf As SldWorks.Surface
936     ' Dim vCurveBounds As Object, vPointArray As Object, vTArray As Object, vUVArray As Object
937     ' Dim nCurveBounds(5) As Double
938     ' Dim bRet As Boolean
939     ' Dim i As Integer
940    
941     ' swSurf = swFace.GetSurface
942    
943     ' ' 2- on va chercher les paramètres de la spline avec Curve::ConvertLineToBcurve
944     ' If swCurve.IsLine Then
945     ' Dim startp(2) As Double
946     ' Dim endp(2) As Double
947     ' Dim vStart As Object
948     ' Dim vEnd As Object
949    
950     ' vCurveParam = swCurve.LineParams()
951     ' startp(0) = vCurveParam(0)
952     ' startp(1) = vCurveParam(1)
953     ' startp(2) = vCurveParam(2)
954     ' vStart = startp
955    
956     ' endp(0) = vCurveParam(3)
957     ' endp(1) = vCurveParam(4)
958     ' endp(2) = vCurveParam(5)
959     ' vEnd = endp
960    
961     ' Dim retval As Object
962     ' Dim valeur As Double
963     ' Dim dimension As Integer
964     ' Dim ordre As Integer
965     ' Dim nbpoints As Integer
966     ' Dim periodique As Integer
967    
968     ' retval = swCurve.ConvertLineToBcurve(vStart, vEnd)
969    
970     ' ' on suppose que la droite est toujours transformée en spline non-rationelle de dimension 3 et d'ordre 2
971     ' Dim knots(3) As Double
972     ' Dim ctrlPoints(5) As Double
973    
974     ' knots(0) = retval(2)
975     ' knots(1) = retval(3)
976     ' knots(2) = retval(4)
977     ' knots(3) = retval(5)
978    
979     ' ctrlPoints(0) = retval(6)
980     ' ctrlPoints(1) = retval(7)
981     ' ctrlPoints(2) = retval(8)
982     ' ctrlPoints(3) = retval(9)
983     ' ctrlPoints(4) = retval(10)
984     ' ctrlPoints(5) = retval(11)
985    
986     ' '3 - on créé une spline dans le modeleur
987    
988    
989     ' Dim modeler As SldWorks.Modeler
990     ' modeler = swApp.GetModeler
991     ' Dim props As Object
992     ' Dim dProps(1) As Double
993     ' Dim vKnots As Object, vCtrlPoints As Object
994    
995     ' dProps(0) = retval(0)
996     ' dProps(1) = retval(1)
997     ' props = dProps
998     ' vKnots = knots
999     ' vCtrlPoints = ctrlPoints
1000    
1001     ' swCurve = modeler.CreateBsplineCurve(props, vKnots, vCtrlPoints)
1002     ' ' 4 - on a une spline, on peut utiliser la fonction IntersectCurve
1003     ' End If
1004    
1005    
1006     ' For i = 0 To 5
1007     ' nCurveBounds(i) = vCurveParam(i)
1008     ' Next i
1009    
1010     ' vCurveBounds = nCurveBounds
1011     ' bRet = swSurf.IntersectCurve(swCurve, vCurveBounds, vPointArray, vTArray, vUVArray)
1012    
1013     ' Dim Pts() As Double
1014     ' Dim PointsTemp() As Double
1015     ' Dim j As Integer
1016    
1017     ' Pts = vPointArray
1018    
1019     ' If UBound(Pts) < 1 Then Return False
1020     ' ' ATTENTION, le point n'est pas nécessairement dans la face
1021     ' For i = 0 To UBound(Pts) - 1 Step 3
1022     ' If Commun.Distance(swFace, Pts(i + 0), Pts(i + 1), Pts(i + 2)) < Epsilon Then
1023     ' ReDim Preserve PointsTemp(j + 2)
1024     ' PointsTemp(j) = Pts(i + 0)
1025     ' PointsTemp(j + 1) = Pts(i + 1)
1026     ' PointsTemp(j + 2) = Pts(i + 2)
1027     ' j += 3
1028     ' End If
1029     ' Next
1030    
1031     ' xyz = PointsTemp
1032     ' If xyz Is Nothing Then Return False
1033     ' If UBound(xyz) > 0 Then Return True
1034    
1035    
1036     'End Function
1037    
1038     Private Function DetectFaceArete(ByRef swArete As SldWorks.Edge, ByRef swFace As SldWorks.Face2, ByRef xyz() As Double) As Boolean
1039     ' function qui détecte si une arête coupe une face, si c'est le cas la function retourne true et remplie le tableau xyz avec le point d'intersection
1040    
1041     Dim P1 As Object = Nothing, p2 As Object = Nothing
1042 bournival 48 If swModel.ClosestDistance(swArete, swFace, P1, p2) > Epsilon Then Return False
1043 bournival 40
1044     Dim swCurve As SldWorks.Curve
1045     Dim swSurf As SldWorks.Surface
1046     Dim vCurveParam As Object
1047    
1048     Dim vCurveBounds As Object, vPointArray As Object = Nothing, vTArray As Object = Nothing, vUVArray As Object = Nothing
1049     Dim nCurveBounds(5) As Double
1050     Dim bRet As Boolean
1051     Dim i As Integer
1052    
1053     '1 - on va chercher la courbe et la surface
1054     swCurve = swArete.GetCurve
1055     swSurf = swFace.GetSurface
1056    
1057    
1058     ' 2- on va chercher les paramètres de la spline avec Curve::ConvertLineToBcurve
1059     vCurveParam = swArete.GetCurveParams2
1060     If swCurve.IsLine Then
1061     Dim startp(2) As Double
1062     Dim endp(2) As Double
1063     Dim vStart As Object
1064     Dim vEnd As Object
1065    
1066    
1067     startp(0) = vCurveParam(0)
1068     startp(1) = vCurveParam(1)
1069     startp(2) = vCurveParam(2)
1070     vStart = startp
1071    
1072     endp(0) = vCurveParam(3)
1073     endp(1) = vCurveParam(4)
1074     endp(2) = vCurveParam(5)
1075     vEnd = endp
1076    
1077     Dim retval As Object
1078    
1079     retval = swCurve.ConvertLineToBcurve(vStart, vEnd)
1080    
1081     ' on suppose que la droite est toujours transformée en spline non-rationelle de dimension 3 et d'ordre 2
1082     Dim knots(3) As Double
1083     Dim ctrlPoints(5) As Double
1084    
1085     knots(0) = retval(2)
1086     knots(1) = retval(3)
1087     knots(2) = retval(4)
1088     knots(3) = retval(5)
1089    
1090     ctrlPoints(0) = retval(6)
1091     ctrlPoints(1) = retval(7)
1092     ctrlPoints(2) = retval(8)
1093     ctrlPoints(3) = retval(9)
1094     ctrlPoints(4) = retval(10)
1095     ctrlPoints(5) = retval(11)
1096    
1097     '3 - on créé une spline dans le modeleur
1098    
1099    
1100     Dim modeler As SldWorks.Modeler
1101     modeler = swApp.GetModeler
1102     Dim props As Object
1103     Dim dProps(1) As Double
1104     Dim vKnots As Object, vCtrlPoints As Object
1105    
1106     dProps(0) = retval(0)
1107     dProps(1) = retval(1)
1108     props = dProps
1109     vKnots = knots
1110     vCtrlPoints = ctrlPoints
1111    
1112     swCurve = modeler.CreateBsplineCurve(props, vKnots, vCtrlPoints)
1113     ' 4 - on a une spline, on peut utiliser la fonction IntersectCurve
1114     End If
1115    
1116    
1117     For i = 0 To 5
1118     nCurveBounds(i) = vCurveParam(i)
1119     Next i
1120    
1121     vCurveBounds = nCurveBounds
1122     bRet = swSurf.IntersectCurve(swCurve, vCurveBounds, vPointArray, vTArray, vUVArray)
1123    
1124     Dim Pts() As Double
1125     Dim PointsTemp() As Double = Nothing
1126     Dim j As Integer
1127    
1128     Pts = vPointArray
1129    
1130     If UBound(Pts) < 1 Then Return False
1131     ' ATTENTION, le point n'est pas nécessairement dans la face
1132     For i = 0 To UBound(Pts) - 1 Step 3
1133     If Commun.Distance(swFace, Pts(i + 0), Pts(i + 1), Pts(i + 2)) < Epsilon Then
1134     ReDim Preserve PointsTemp(j + 2)
1135     PointsTemp(j) = Pts(i + 0)
1136     PointsTemp(j + 1) = Pts(i + 1)
1137     PointsTemp(j + 2) = Pts(i + 2)
1138     j += 3
1139     End If
1140     Next
1141    
1142     xyz = PointsTemp
1143     If xyz Is Nothing Then Return False
1144     If UBound(xyz) > 0 Then Return True
1145    
1146     End Function
1147    
1148    
1149    
1150 bournival 130 Private Function DetectFaceArete(ByRef swArete As sldworks.Edge, ByRef Slyface As SlyFaceVolume, ByRef xyz() As Double, Optional ByRef SurSurface As Boolean = False) As Boolean
1151     Dim swface As sldworks.Face2
1152    
1153 bournival 40 For Each swface In Slyface.lst_Faces
1154     If DetectFaceArete(swArete, swface, xyz) Then
1155     Dim vEdges As Object
1156 bournival 130 Dim Arete As sldworks.Edge
1157 bournival 40 Dim inu() As Double = Nothing
1158    
1159     vEdges = swface.GetEdges
1160    
1161     For Each Arete In vEdges
1162     If DetectAreteArete(Arete, swArete, inu) Then
1163     ' on a un type d'intersection entre une face et une arète...
1164 bournival 130 Dim swSurf As sldworks.Surface
1165 bournival 40 Dim retval As Object
1166     Dim v(2) As Double
1167     Dim u(2) As Double
1168     Dim angle As Double
1169     swSurf = swface.GetSurface
1170     retval = swSurf.EvaluateAtPoint(xyz(0), xyz(1), xyz(2))
1171     ' les 3 premiers de retval sont la normale...
1172     v(0) = retval(0) : v(1) = retval(1) : v(2) = retval(2)
1173    
1174     retval = swArete.GetParameter(inu(0), inu(1), inu(2))
1175     retval = swArete.Evaluate(retval(0))
1176     u(0) = retval(3) : u(1) = retval(4) : u(2) = retval(5)
1177     angle = Outils_Math.Angle2Vecteurs(u, v)
1178 bournival 130 'MsgBox(angle * 180 / Pi & "<-- angle sens --> " & swface.FaceInSurfaceSense & vbCr & "Aire = " & Slyface.Aire)
1179 bournival 40
1180 bournival 130
1181     'Si l'angle entre la normale de la face et la normale de la courbe est de 0
1182     ' ou de pi/2 alors on a une SurSurface
1183     If Math.Abs(angle - Pi / 2) < 100 * Epsilon Or Math.Abs(angle) < 100 * Epsilon Then
1184     SurSurface = True
1185     Else
1186 bournival 40 Return True
1187     End If
1188 bournival 130
1189     'If ((angle < (Pi / 2)) Xor swface.FaceInSurfaceSense()) Then
1190     ' Return True
1191     'Else
1192     ' SurSurface = True
1193     'End If
1194 bournival 40 End If
1195     Next
1196    
1197    
1198 bournival 130 If Not SurSurface Then Return True Else Return False
1199 bournival 40 End If
1200     Next
1201     End Function
1202    
1203    
1204    
1205    
1206     Private Function DetectSurfaceArete(ByRef swArete As SldWorks.Edge, ByRef swFace As SldWorks.Face2, ByRef xyz() As Double) As Boolean
1207     ' function qui détecte si une arête coupe une face, si c'est le cas la function retourne true et remplie le tableau xyz avec le point d'intersection
1208     Dim swCurve As SldWorks.Curve
1209     Dim swSurf As SldWorks.Surface
1210     Dim vCurveParam As Object
1211    
1212     Dim vCurveBounds As Object, vPointArray As Object = Nothing, vTArray As Object = Nothing, vUVArray As Object = Nothing
1213     Dim nCurveBounds(5) As Double
1214     Dim bRet As Boolean
1215     Dim i As Integer
1216    
1217     '1 - on va chercher la courbe et la surface
1218     swCurve = swArete.GetCurve
1219     swSurf = swFace.GetSurface
1220    
1221    
1222     ' 2- on va chercher les paramètres de la spline avec Curve::ConvertLineToBcurve
1223     vCurveParam = swArete.GetCurveParams2
1224     If swCurve.IsLine Then
1225     Dim startp(2) As Double
1226     Dim endp(2) As Double
1227     Dim vStart As Object
1228     Dim vEnd As Object
1229    
1230    
1231     startp(0) = vCurveParam(0)
1232     startp(1) = vCurveParam(1)
1233     startp(2) = vCurveParam(2)
1234     vStart = startp
1235    
1236     endp(0) = vCurveParam(3)
1237     endp(1) = vCurveParam(4)
1238     endp(2) = vCurveParam(5)
1239     vEnd = endp
1240    
1241     Dim retval As Object
1242    
1243     retval = swCurve.ConvertLineToBcurve(vStart, vEnd)
1244    
1245     ' on suppose que la droite est toujours transformée en spline non-rationelle de dimension 3 et d'ordre 2
1246     Dim knots(3) As Double
1247     Dim ctrlPoints(5) As Double
1248    
1249     knots(0) = retval(2)
1250     knots(1) = retval(3)
1251     knots(2) = retval(4)
1252     knots(3) = retval(5)
1253    
1254     ctrlPoints(0) = retval(6)
1255     ctrlPoints(1) = retval(7)
1256     ctrlPoints(2) = retval(8)
1257     ctrlPoints(3) = retval(9)
1258     ctrlPoints(4) = retval(10)
1259     ctrlPoints(5) = retval(11)
1260    
1261     '3 - on créé une spline dans le modeleur
1262    
1263    
1264     Dim modeler As SldWorks.Modeler
1265     modeler = swApp.GetModeler
1266     Dim props As Object
1267     Dim dProps(1) As Double
1268     Dim vKnots As Object, vCtrlPoints As Object
1269    
1270     dProps(0) = retval(0)
1271     dProps(1) = retval(1)
1272     props = dProps
1273     vKnots = knots
1274     vCtrlPoints = ctrlPoints
1275    
1276     swCurve = modeler.CreateBsplineCurve(props, vKnots, vCtrlPoints)
1277     ' 4 - on a une spline, on peut utiliser la fonction IntersectCurve
1278     End If
1279    
1280    
1281     For i = 0 To 5
1282     nCurveBounds(i) = vCurveParam(i)
1283     Next i
1284    
1285     vCurveBounds = nCurveBounds
1286     bRet = swSurf.IntersectCurve(swCurve, vCurveBounds, vPointArray, vTArray, vUVArray)
1287    
1288     Dim Pts() As Double
1289     Dim PointsTemp() As Double = Nothing
1290     Dim j As Integer
1291    
1292     Pts = vPointArray
1293    
1294     If UBound(Pts) < 1 Then Return False
1295    
1296     For i = 0 To UBound(Pts) - 1 Step 3
1297     ReDim Preserve PointsTemp(j + 2)
1298     PointsTemp(j) = Pts(i + 0)
1299     PointsTemp(j + 1) = Pts(i + 1)
1300     PointsTemp(j + 2) = Pts(i + 2)
1301     j += 3
1302     Next i
1303    
1304     xyz = PointsTemp
1305     If xyz Is Nothing Then Return False
1306     If UBound(xyz) > 0 Then Return True
1307    
1308    
1309     End Function
1310    
1311    
1312    
1313     Private Function DetectSommetArete(ByRef swsommet As SldWorks.Vertex, ByRef swArete As SldWorks.Edge, ByRef xyz() As Double) As Boolean
1314     Dim x As Double, y As Double, z As Double
1315     Dim vPoint As Object
1316     Dim vPoint2 As Object
1317     vPoint = swsommet.GetPoint
1318    
1319     x = vPoint(0)
1320     y = vPoint(1)
1321     z = vPoint(2)
1322    
1323     vPoint2 = swArete.GetClosestPointOn(x, y, z)
1324     If Math.Abs(vPoint2(0) - x) < Epsilon And Math.Abs(vPoint2(1) - y) < Epsilon And Math.Abs(vPoint2(2) - z) < Epsilon Then
1325     ReDim xyz(2)
1326     xyz(0) = x
1327     xyz(1) = y
1328     xyz(2) = z
1329     DetectSommetArete = True
1330     End If
1331    
1332     End Function
1333    
1334    
1335     Private Function DetectSommetArete(ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef swArete As SldWorks.Edge) As Byte
1336     Dim vPoint As Object
1337     Dim vPoint2 As Object
1338    
1339     vPoint2 = swArete.GetClosestPointOn(x, y, z)
1340     If Math.Abs(vPoint2(0) - x) < Epsilon And Math.Abs(vPoint2(1) - y) < Epsilon And Math.Abs(vPoint2(2) - z) < Epsilon Then
1341     DetectSommetArete = 1
1342    
1343     ' maintenant on cherche à savoir si ca touche au premier sommet de l'arrête.
1344     vPoint = swArete.GetCurveParams2()
1345    
1346     If Math.Abs(vPoint(0) - x) < Epsilon And Math.Abs(vPoint(1) - y) < Epsilon And Math.Abs(vPoint(2) - z) < Epsilon Then DetectSommetArete = 2
1347     If Math.Abs(vPoint(3) - x) < Epsilon And Math.Abs(vPoint(4) - y) < Epsilon And Math.Abs(vPoint(5) - z) < Epsilon Then DetectSommetArete = 2
1348    
1349     End If
1350    
1351     End Function
1352    
1353     Private Function DetectSommetArete(ByRef swArete2som As SldWorks.Edge, ByRef swArete As SldWorks.Edge, ByRef xyz() As Double, Optional ByRef ret As Byte = 0) As Boolean
1354     ' ret: 1 = sur premier sommet, 2 = sur dernier sommet
1355     Dim x As Double, y As Double, z As Double
1356     Dim vPoint As Object
1357     Dim vPoint2 As Object
1358     Dim swSommet As SldWorks.Vertex
1359    
1360     swSommet = swArete2som.GetStartVertex
1361     If IsNothing(swSommet) Then Exit Function ' on a un cercle...
1362    
1363    
1364     vPoint = swSommet.GetPoint
1365    
1366     x = vPoint(0)
1367     y = vPoint(1)
1368     z = vPoint(2)
1369    
1370     vPoint2 = swArete.GetClosestPointOn(x, y, z)
1371     If Math.Abs(vPoint2(0) - x) < Epsilon And Math.Abs(vPoint2(1) - y) < Epsilon And Math.Abs(vPoint2(2) - z) < Epsilon Then
1372     ReDim xyz(2)
1373     xyz(0) = x
1374     xyz(1) = y
1375     xyz(2) = z
1376     DetectSommetArete = True
1377     ret += 1
1378     End If
1379    
1380     swSommet = swArete2som.GetEndVertex
1381     vPoint = swSommet.GetPoint
1382    
1383     x = vPoint(0)
1384     y = vPoint(1)
1385     z = vPoint(2)
1386    
1387     vPoint2 = swArete.GetClosestPointOn(x, y, z)
1388     If Math.Abs(vPoint2(0) - x) < Epsilon And Math.Abs(vPoint2(1) - y) < Epsilon And Math.Abs(vPoint2(2) - z) < Epsilon Then
1389     ReDim xyz(2)
1390     xyz(0) = x
1391     xyz(1) = y
1392     xyz(2) = z
1393     DetectSommetArete = True
1394     ret += 2
1395     End If
1396    
1397    
1398     End Function
1399    
1400     Private Sub Memoriser3iemePoint()
1401     Dim poutre As SlyAretePoutre
1402     Dim attr As SldWorks.Attribute
1403     Dim p As SldWorks.Parameter
1404     Dim swEnt As SldWorks.Entity
1405    
1406    
1407    
1408     For Each poutre In Commun.lst_AretePoutre
1409     Dim xyz() As Double
1410     Dim nom As String = Nothing
1411    
1412     If Not poutre.IsFaceDeSection Then
1413     xyz = poutre.GetPoint3(nom)
1414    
1415     poutre.X3 = xyz(0)
1416     poutre.Y3 = xyz(1)
1417     poutre.Z3 = xyz(2)
1418    
1419     swEnt = poutre.swArete
1420    
1421     attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1422     p = attr.GetParameter("N3")
1423    
1424     p = attr.GetParameter("X3")
1425     p.SetDoubleValue2(poutre.X3, 2, "")
1426    
1427     p = attr.GetParameter("Y3")
1428     p.SetDoubleValue2(poutre.Y3, 2, "")
1429    
1430     p = attr.GetParameter("Z3")
1431     p.SetDoubleValue2(poutre.Z3, 2, "")
1432     End If
1433     Next poutre
1434    
1435     End Sub
1436    
1437    
1438    
1439     Private Sub CouperPoutres()
1440    
1441     ' procédure qui trouve les intersections entre les poutres et qui les coupe.
1442     ' à la fin on a plus d'intersections entre les poutres (ailleur qu'un sommet)
1443    
1444     Dim swArete1 As SldWorks.Edge
1445     Dim swArete2 As SldWorks.Edge
1446     Dim SlyArete1 As SlyAretePoutre
1447     Dim SlyArete2 As SlyAretePoutre
1448    
1449     Dim xyz() As Double = Nothing
1450     Dim pt As New InterPoutrePoutre
1451     'Dim lst_pts As New Collection
1452     Dim i As Long
1453    
1454     Dim a1 As Integer
1455     Dim a2 As Integer
1456    
1457 bournival 130 Try
1458     For a1 = 0 To lst_AretePoutre.Count - 1
1459     SlyArete1 = lst_AretePoutre.Item(a1)
1460     swArete1 = SlyArete1.swArete
1461 bournival 40
1462 bournival 130 If Not a1 = lst_AretePoutre.Count - 1 Then
1463     For a2 = a1 + 1 To lst_AretePoutre.Count - 1
1464     SlyArete2 = lst_AretePoutre.Item(a2)
1465     swArete2 = SlyArete2.swArete
1466 bournival 40
1467 bournival 130 If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1468     For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1469 bournival 40
1470 bournival 130 Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1471     Case 1 ' la première courbe est coupée
1472     pt = New InterPoutrePoutre
1473     pt.Arete = swArete1
1474     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1475     SlyArete1.AjouterPointAPAP(pt)
1476     pt = Nothing
1477     Case 2 ' la seconde courbe est coupée
1478     pt = New InterPoutrePoutre
1479     pt.Arete = swArete2
1480     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1481     SlyArete2.AjouterPointAPAP(pt)
1482     pt = Nothing
1483     Case 3 ' les doux poutres sont coupées
1484     pt = New InterPoutrePoutre
1485     pt.Arete = swArete1
1486     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1487     SlyArete1.AjouterPointAPAP(pt)
1488     pt = Nothing
1489     pt = New InterPoutrePoutre
1490     pt.Arete = swArete2
1491     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1492     SlyArete2.AjouterPointAPAP(pt)
1493     pt = Nothing
1494     End Select
1495     Next i
1496     End If
1497 bournival 40
1498 bournival 130 Next a2
1499 bournival 40 End If
1500    
1501 bournival 130 Dim SlyArete3 As SlyAreteCoque
1502     For a2 = 0 To lst_AreteCoque.Count - 1
1503     SlyArete3 = lst_AreteCoque.Item(a2)
1504     swArete2 = SlyArete3.swArete
1505 bournival 40
1506 bournival 130 If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1507     For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1508 bournival 40
1509 bournival 130 Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1510     Case 1 ' la première courbe est coupée
1511     pt = New InterPoutrePoutre
1512     pt.Arete = swArete1
1513     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1514     SlyArete1.AjouterPointAPAP(pt)
1515     pt = Nothing
1516     ' seul la coque est coupée, elle sera découpée anyway.
1517     Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1518     pt = New InterPoutrePoutre
1519     pt.Arete = swArete1
1520     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1521     SlyArete1.AjouterPointAPAP(pt)
1522     pt = Nothing
1523     End Select
1524     Next i
1525     End If
1526     Next a2
1527 bournival 40
1528 bournival 130 Dim slyarete4 As SlyAreteVol
1529     For a2 = 0 To lst_AreteVolume.Count - 1
1530     slyarete4 = lst_AreteVolume.Item(a2)
1531     swArete2 = slyarete4.swArete
1532 bournival 40
1533 bournival 130 If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1534     For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1535 bournival 40
1536 bournival 130 Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1537     Case 1 ' la première courbe est coupée
1538     pt = New InterPoutrePoutre
1539     pt.Arete = swArete1
1540     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1541     SlyArete1.AjouterPointAPAP(pt)
1542     pt = Nothing
1543     Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1544     pt = New InterPoutrePoutre
1545     pt.Arete = swArete1
1546     pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1547     SlyArete1.AjouterPointAPAP(pt)
1548     pt = Nothing
1549     End Select
1550     Next i
1551     End If
1552     Next a2
1553 bournival 40
1554    
1555    
1556 bournival 130 Next a1
1557     pt = Nothing
1558 bournival 40
1559 bournival 130 Catch
1560     MsgBox(" La première boucle n'a pas marchée")
1561     End Try
1562 bournival 40
1563    
1564 bournival 130 Dim count As Long = 0, count2 As Long = 0
1565     Try
1566 bournival 40
1567 bournival 130 'toutes les poutres ont des points où elles doivent être coupées
1568     ' il suffit de couper.
1569     ' en réalité on suppress et on créé 2 ou plus courbes par dessus.
1570     Dim attr As sldworks.Attribute
1571     Dim swEnt As sldworks.Entity
1572 bournival 40
1573 bournival 130 For Each SlyArete1 In lst_AretePoutre
1574     If SlyArete1.lst_PtsInterAPAP.Count > 0 Then ' on coupe
1575     '1 - ordonner les points, de Tmin à Tmax et inclure les 2 extrémités de la poutre
1576 bournival 40
1577 bournival 130 count += 1
1578     ' si c'est une droite
1579     If SlyArete1.IsLine Then
1580     Dim Pts(,) As Double
1581     Dim swSketch As sldworks.Sketch
1582     ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1583 bournival 40
1584 bournival 130 SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1585     Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1586 bournival 40
1587 bournival 130 For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1588     Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1589     Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1590     Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1591     Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1592     Next i
1593 bournival 40
1594 bournival 130 Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1595     SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1596     Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1597 bournival 40
1598 bournival 130 ' faut ordonner les points selon T...
1599     Dim j As Integer
1600     Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1601     For i = 0 To max - 2
1602     For j = 0 To max - i - 1
1603     If Pts(3, j) > Pts(3, j + 1) Then
1604     T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1605     Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
1606     Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1607     End If
1608     Next j
1609     Next i
1610 bournival 40
1611    
1612 bournival 130 For i = 0 To UBound(Pts, 2) - 1
1613     swModel.Insert3DSketch2(False)
1614     swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1)) ' et pour chaque segment
1615     swSketch = swModel.GetActiveSketch2
1616     swModel.Insert3DSketch2(False)
1617 bournival 40
1618 bournival 130 swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1619     swModel.InsertCompositeCurve()
1620     Try
1621     count2 += 1
1622     UpdateAttributs(SlyArete1, i) 'ajouter les attributs de la vieille poutre sur la nouvelle
1623     Catch
1624     MsgBox("UpdateAttribut n'a pas marché au compte # " & count2)
1625     End Try
1626     Next i
1627 bournival 40
1628    
1629 bournival 130 Else ' If SlyArete1.IsCircle Then ' si c'est un cercle
1630 bournival 40
1631 bournival 130 Dim Pts(,) As Double
1632     Dim swSketch As sldworks.Sketch
1633     ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1634 bournival 40
1635 bournival 130 SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1636     Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1637 bournival 40
1638 bournival 130 For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1639     Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1640     Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1641     Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1642     Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1643     Next i
1644 bournival 40
1645 bournival 130 Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1646     SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1647     Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1648 bournival 40
1649 bournival 130 ' faut ordonner les points selon T...
1650     Dim j As Integer
1651     Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1652     For i = 0 To max - 2
1653     For j = 0 To max - i - 1
1654     If Pts(3, j) > Pts(3, j + 1) Then
1655     T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1656     Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
1657     Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1658     End If
1659     Next j
1660     Next i
1661 bournival 40
1662 bournival 130 Dim skSeg As sldworks.SketchSegment
1663     Dim x As Double, y As Double, z As Double
1664     Dim vretval As Object
1665     Dim useEdge As sldworks.SketchSegment
1666     Dim m As Integer
1667 bournival 40
1668    
1669 bournival 130 For i = 0 To UBound(Pts, 2) - 1
1670     swModel.Insert3DSketch2(False)
1671     ' sélectionner la edge originale
1672     swEnt = SlyArete1.swArete
1673     swEnt.Select4(False, Nothing)
1674     swModel.SketchUseEdge2(False)
1675     swSketch = swModel.GetActiveSketch2()
1676 bournival 40
1677 bournival 130 ' on créé 2 lignes de construction et on pick de chaque coté... mais on ne le fait pas si on est au premier ou au dernier segment. là on fait juste un pick.
1678     If i <> 0 Then ' premier pick, élimine ce qui est avant.
1679     skSeg = swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), 0.01, 0.01, 0.01) 'pts(0, i - 1) + 10000000 * Epsilon, pts(1, i - 1) + 100000 * Epsilon, pts(2, i - 1) + 100000 * Epsilon)
1680     skSeg.ConstructionGeometry = True ' ligne de construction
1681     swModel.ClearSelection2(True)
1682     ' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1683     SlyArete1.Evaluer((Pts(3, i - 1) + Pts(3, i)) / 2, x, y, z)
1684     vretval = swSketch.GetSketchSegments
1685     useEdge = vretval(0) : m = 0
1686     Do Until useEdge.ConstructionGeometry = False
1687     m += 1
1688     useEdge = vretval(m)
1689     Loop
1690     useEdge.Select4(False, Nothing)
1691     swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner. et y'a pas de Z????? c'est un sketch3D!!!!!
1692     skSeg = swModel.CreateLine2(0, 0, 0, x, y, 0)
1693     skSeg.ConstructionGeometry = True
1694     End If
1695 bournival 40
1696 bournival 130 If i <> UBound(Pts, 2) - 1 Then 'Second(pick)
1697     skSeg = swModel.CreateLine2(Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1), 0.05, 0, 0.01) 'pts(0, i + 1) + 10000000 * Epsilon, pts(1, i + 1) + 1000000 * Epsilon, pts(2, i + 1) + 100000 * Epsilon)
1698     skSeg.ConstructionGeometry = True ' ligne de construction
1699     swModel.ClearSelection2(True)
1700 bournival 40
1701 bournival 130 ' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1702     SlyArete1.Evaluer((Pts(3, i + 1) + Pts(3, i + 2)) / 2, x, y, z)
1703     vretval = swSketch.GetSketchSegments
1704     useEdge = vretval(0) : m = 0
1705     Do Until useEdge.ConstructionGeometry = False
1706     m += 1
1707     useEdge = vretval(m)
1708     Loop
1709 bournival 40
1710 bournival 130 useEdge.Select4(False, Nothing)
1711     swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner. et y'a pas de Z????? c'est un sketch3D!!!!!
1712     skSeg = swModel.CreateLine2(0, 0.02, 0, x, y, 0)
1713     skSeg.ConstructionGeometry = True
1714     End If
1715 bournival 40
1716 bournival 130 swModel.Insert3DSketch2(False)
1717     swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1718     swModel.InsertCompositeCurve()
1719     UpdateAttributs(SlyArete1, i)
1720     Next i
1721 bournival 40
1722 bournival 130 End If
1723 bournival 40
1724 bournival 130 ' tagger la vieille poutre pour ne pas la reprendre dans magic
1725     'Pour ça on ajoute un attribut pour ignorer...
1726     Dim nom As String
1727     Dim no As Integer
1728     Dim arete As sldworks.Edge
1729 bournival 40
1730 bournival 130 arete = SlyArete1.swArete
1731     swEnt = arete
1732     nom = "Ignorer" & SlyArete1.nom & "_" & CStr(no)
1733 bournival 40 attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1734 bournival 130 'attr = DefAttrRCP1.CreateInstance5(swModel, arete, nom, 0, 2) ' une deuxième instance du RCPoutre...
1735     If attr Is Nothing Then
1736     Commun.ColorerAretes()
1737     swEnt = SlyArete1.swArete
1738     attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1739     End If
1740 bournival 40
1741 bournival 130 Dim p As sldworks.Parameter
1742     p = attr.GetParameter("D1")
1743     p.SetDoubleValue(-9)
1744     p = attr.GetParameter("D2")
1745     p.SetDoubleValue(-9)
1746     p = attr.GetParameter("D3")
1747     p.SetDoubleValue(-9)
1748     p = attr.GetParameter("D4")
1749     p.SetDoubleValue(-9)
1750 bournival 40
1751 bournival 130 If attr Is Nothing Then MsgBox("Pas marché")
1752 bournival 40
1753    
1754 bournival 130 End If
1755     Next SlyArete1
1756     Catch
1757     MsgBox("La seconde boucle n'a pas marchée Compte: " & count)
1758     End Try
1759 bournival 40
1760     End Sub
1761    
1762    
1763 bournival 130 Private Sub UpdateAttributs(ByRef slyarete1 As SlyAretePoutre, ByVal i As Integer)
1764     Dim newArete As sldworks.Edge
1765     Dim refcurve As sldworks.ReferenceCurve
1766     Dim attr As sldworks.Attribute = Nothing
1767     Dim swfeat As sldworks.Feature
1768     swModel.EditRebuild3()
1769 bournival 40 swfeat = swModel.FeatureByPositionReverse(0)
1770    
1771 bournival 130 Debug.Print(swfeat.Name & "<-- Nom Typename--> " & swfeat.GetTypeName)
1772    
1773 bournival 40 refcurve = swfeat.GetSpecificFeature2()
1774     newArete = refcurve.GetFirstSegment()
1775    
1776 bournival 130 Dim ParamM As sldworks.Parameter
1777     Dim ParamS As sldworks.Parameter
1778     Dim ParamI1 As sldworks.Parameter
1779     Dim ParamI2 As sldworks.Parameter
1780     Dim ParamD1 As sldworks.Parameter
1781     Dim ParamD2 As sldworks.Parameter
1782     Dim ParamD3 As sldworks.Parameter
1783     Dim ParamD4 As sldworks.Parameter
1784     Dim ParamD5 As sldworks.Parameter
1785     Dim ParamD6 As sldworks.Parameter
1786     Dim ParamAs As sldworks.Parameter
1787     Dim ParamN3 As sldworks.Parameter
1788 bournival 40
1789 bournival 130 Do While attr Is Nothing
1790     attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, newArete, "Nouveau" & i & slyarete1.nom, 0, 2)
1791     i += 1
1792     Loop
1793 bournival 40
1794     ParamM = attr.GetParameter("M")
1795     ParamS = attr.GetParameter("S")
1796     ParamI1 = attr.GetParameter("I1")
1797     ParamI2 = attr.GetParameter("I2")
1798     ParamD1 = attr.GetParameter("D1")
1799     ParamD2 = attr.GetParameter("D2")
1800     ParamD3 = attr.GetParameter("D3")
1801     ParamD4 = attr.GetParameter("D4")
1802     ParamD5 = attr.GetParameter("D5")
1803     ParamD6 = attr.GetParameter("D6")
1804     ParamAs = attr.GetParameter("As")
1805    
1806     ParamM.SetStringValue2(slyarete1.GetM, 2, "") ' swAllConfiguration = 2
1807     ParamS.SetStringValue2(slyarete1.GetSection, 2, "")
1808     ParamI1.SetDoubleValue2(slyarete1.GetInertieXX, 2, "")
1809     ParamI2.SetDoubleValue2(slyarete1.GetInertieYY, 2, "")
1810     ParamD1.SetDoubleValue2(slyarete1.GetD1, 2, "")
1811     ParamD2.SetDoubleValue2(slyarete1.GetD2, 2, "")
1812     ParamD3.SetDoubleValue2(slyarete1.GetD3, 2, "")
1813     ParamD4.SetDoubleValue2(slyarete1.GetD4, 2, "")
1814     ParamD5.SetDoubleValue2(slyarete1.GetD5, 2, "")
1815     ParamD6.SetDoubleValue2(slyarete1.GetD6, 2, "")
1816     ParamAs.SetDoubleValue2(slyarete1.GetAireSection, 2, "")
1817    
1818 bournival 130 Dim p As sldworks.Parameter
1819 bournival 40 p = attr.GetParameter("N3")
1820     p.SetStringValue(slyarete1.GetN3)
1821     p = attr.GetParameter("X3")
1822     p.SetDoubleValue2(slyarete1.X3, 2, "")
1823     p = attr.GetParameter("Y3")
1824     p.SetDoubleValue2(slyarete1.Y3, 2, "")
1825     p = attr.GetParameter("Z3")
1826     p.SetDoubleValue2(slyarete1.Z3, 2, "")
1827    
1828 bournival 130 ' Commun.GererDossiers("Poutres", "Nouveau" & i & slyarete1.nom)
1829 bournival 40
1830     End Sub
1831    
1832    
1833    
1834    
1835     ''' <summary>
1836     ''' sub qui gère la détection des intersections entre les coques et les volumes.
1837     ''' </summary>
1838     ''' <remarks></remarks>
1839     Private Sub DetectionCoqueVolume()
1840    
1841     ' détection de coque-coque
1842     Dim Face1 As SlyFaceVolume
1843     Dim coque2 As SlyFaceCoque
1844     Dim sketch As SldWorks.Sketch = Nothing
1845     Dim interFF As InterCoqueVolume
1846    
1847     For Each Face1 In Commun.lst_FaceVolume
1848     For Each coque2 In lst_FaceCoque
1849    
1850     If DetectFaceFace(coque2, Face1, True, sketch) Then
1851 bournival 130 ' création de l'instance de interFace-face entre coque et volume
1852 bournival 40
1853 bournival 130 Dim vSeg As Object = sketch.GetSketchSegments()
1854     If vSeg Is Nothing Then
1855     DetectFaceFace(coque2, Face1, True, sketch)
1856     vSeg = sketch.GetSketchSegments()
1857     If vSeg Is Nothing Then MsgBox("Problème") : Err.Raise(555)
1858     End If
1859 bournival 40
1860 bournival 130
1861    
1862 bournival 40 interFF = New InterCoqueVolume
1863     interFF.sFaceVolume = Face1
1864     interFF.sFaceCoque = coque2
1865     If coque2.PossedeFaceDeSection = True Then
1866     interFF.FaceDeSection = True
1867     Verifier_Coque_Section(interFF)
1868     Else
1869     interFF.FaceDeSection = False
1870     End If
1871     interFF.sketch = sketch
1872     coque2.lst_InterCoqueVolume.Add(interFF)
1873     End If
1874    
1875 bournival 130 Next coque2
1876     Next Face1
1877 bournival 40
1878    
1879    
1880    
1881     End Sub
1882    
1883     ''' <summary>
1884     ''' Sub qui fait les 6 vérifications pour le type d'intersection où la coque est partiellement dessinée en 3D.
1885     ''' En profite également pour remettre à jour la proriété de l'épaisseur de la coque
1886     ''' </summary>
1887     ''' <param name="interFF">L'intersection</param>
1888     ''' <remarks>On fait au total 6 vérifications</remarks>
1889     Private Sub Verifier_Coque_Section(ByRef interFF As InterCoqueVolume)
1890     Dim sFaceCoque As SlyFaceCoque
1891     Dim sFaceVol As SlyFaceVolume
1892     Dim swFace1 As SldWorks.Face2
1893     Dim swent As SldWorks.Entity
1894    
1895     sFaceCoque = interFF.sFaceCoque
1896     sFaceVol = interFF.sFaceVolume
1897    
1898     ' 1 - vérifier que la face du volume est plane
1899     If Not sFaceVol.estPlan Then
1900     Err.Raise(513, "Verifier_Coque_Section", "La face représentant la section de la coque n'est pas plane...")
1901     End If
1902    
1903     ' 1.5 - La face du volume a 4 courbes, 2 petites de même longueur et 2 longues
1904     ' 1.6 ou qu'elle est une courbe fermée avec 2 loop d'une seule arète chaque.
1905     Dim vEdges As Object
1906     Dim Aretes() As SldWorks.Edge
1907     Dim longueur(3) As Double
1908     Dim i As Integer
1909     Dim a As SldWorks.Edge
1910     ReDim Aretes(0)
1911    
1912     swFace1 = sFaceVol.SwFace
1913    
1914     vEdges = swFace1.GetEdges()
1915     For Each a In vEdges
1916     ReDim Preserve Aretes(i)
1917     Aretes(i) = a
1918     i += 1
1919     Next
1920    
1921     If UBound(Aretes) = 3 Then
1922     For i = 0 To 3
1923     longueur(i) = Commun.GetLongueurArete(Aretes(i))
1924     Next i
1925     longueur = Ordonner(longueur, Aretes)
1926     If Not Math.Abs(longueur(0) - longueur(1)) < Epsilon Then
1927     swent = swFace1 : swent.Select2(False, 0)
1928     Err.Raise(514, "Verifier_Coque_Section", "La face du volume représentant la coque n'a pas 2 petites arètes de la même longueur, ce n'est pas normal. La face a problème a été sélectionée")
1929     End If
1930    
1931     ElseIf UBound(Aretes) = 1 Then ' la coque représente un cylindre (ou un autre truc fermé)
1932     If Not swFace1.GetLoopCount = 2 Then
1933     swent = swFace1 : swent.Select2(False, 0)
1934     Err.Raise(514, "Verifier_Coque_Section", "La face du volume représentant la coque n'a pas 2 ou 4 arêtes ou n'est pas correcte... La face a problème a été sélectionée")
1935     End If
1936     Else
1937     swent = swFace1 : swent.Select2(False, 0)
1938     Err.Raise(514, "Verifier_Coque_Section", "La face du volume représentant la coque n'a pas 2 ou 4 arêtes. La face a problème a été sélectionée")
1939     End If
1940    
1941     ' 2 - Vérifier que la ligne est plane, mais ça je ne sais pas comment
1942    
1943     ' 3 - Perpendiculaire
1944     ' ok, on va chercher le midpoint de la ligne et on demande la normale à cette position des 2 faces. Puis on demande(l) 'angle entre les 2 normales...
1945    
1946     Dim swArete As SldWorks.Edge
1947     Dim vmid As Object
1948     Dim mid() As Double = Nothing
1949     Dim T As Double
1950     Dim u() As Double, v() As Double
1951     Dim angle As Double
1952    
1953 bournival 130 If interFF.AreteCoque Is Nothing Then interFF.QuelleAreteCoqueToucheVolume() : Dim effacer As New SuperArete(interFF.AreteCoque, True) ': effacer.Colorer(2, 0.7, 0, 0.7)
1954 bournival 40 swArete = interFF.AreteCoque
1955     T = Commun.GetTMilieu(swArete)
1956     vmid = swArete.Evaluate(T)
1957     mid = vmid
1958    
1959     u = sFaceVol.GetNormale(mid(0), mid(1), mid(2))
1960     v = sFaceCoque.GetNormale(mid(0), mid(1), mid(2))
1961    
1962     angle = Outils_Math.Angle2Vecteurs(u, v)
1963    
1964     If Not Math.Abs(angle - Pi / 2) < (Epsilon * 10) Then
1965     sFaceVol.Selectionner(, False)
1966     sFaceCoque.Selectionner(, True)
1967     Err.Raise(515, "Verifier_Coque_Section", "La face de la coque n'est pas perpendiculaire à la face représentant sa section. Les faces fautives ont été sélectionées.")
1968     End If
1969    
1970     ' 4 - vérifier que les 2 petites arètes sont coupées au milieu
1971    
1972    
1973     ' maintenant on update l'attribut de la coque, par chance, j'ai les coordonnées du point milieu...
1974     Dim epaisseur As Double
1975     Dim distance1 As Double, distance2 As Double
1976     Dim point1(2) As Double, point2(2) As Double
1977     Dim p As Object = Nothing, p2 As Object = Nothing
1978    
1979     If UBound(Aretes) = 3 Then
1980     p = Aretes(2).GetClosestPointOn(mid(0), mid(1), mid(2))
1981     point1(0) = p(0) : point1(1) = p(1) : point1(2) = p(2)
1982     distance1 = Math.Sqrt((point1(0) - mid(0)) ^ 2 + (point1(1) - mid(1)) ^ 2 + (point1(2) - mid(2)) ^ 2)
1983    
1984     p = Aretes(3).GetClosestPointOn(mid(0), mid(1), mid(2))
1985     point2(0) = p(0) : point2(1) = p(1) : point2(2) = p(2)
1986     distance2 = Math.Sqrt((point2(0) - mid(0)) ^ 2 + (point2(1) - mid(1)) ^ 2 + (point2(2) - mid(2)) ^ 2)
1987    
1988     If Not Math.Abs(distance1 - distance2) < Epsilon Then
1989     Err.Raise(516, "Verifier_Coque_Section", "La distance n'est pas la même de chaque coté de la coque")
1990     Else
1991     epaisseur = distance1 * 2
1992     End If
1993    
1994     ElseIf UBound(Aretes) = 1 Then ' on a des cercles
1995     epaisseur = swModel.ClosestDistance(Aretes(0), Aretes(1), p, p2)
1996     If epaisseur <= 0 Then MsgBox("Il y a un problème ici...")
1997     Else
1998     MsgBox("On ne doit jamias passer ici en principe")
1999     End If
2000    
2001     sFaceCoque.SetAttributDeCoque(epaisseur)
2002    
2003     End Sub
2004    
2005     ''' <summary>
2006     ''' sub qui découpe une face en fonction des paramètres qu'on lui passe.
2007     ''' </summary>
2008     ''' <remarks></remarks>
2009     Private Sub DécouperCoqueVolume()
2010    
2011 bournival 130 ' Algo:
2012     ' Pour chaque coque
2013     ' Si on doit couper la coque, alors on la coupe
2014     ' On découpe la face du volume
2015     ' ON identifie les faces internes
2016    
2017    
2018 bournival 40 Dim coque1 As SlyFaceCoque
2019     Dim interFF As InterCoqueVolume
2020    
2021     ' 1 - Pour toutes les coques
2022 bournival 130 Dim lst_face As New Collections.Generic.List(Of SlyFaceVolume)
2023 bournival 40
2024     For Each coque1 In Commun.lst_FaceCoque
2025 bournival 130
2026 bournival 40 For Each interFF In coque1.lst_InterCoqueVolume
2027 bournival 130
2028     'If interFF.Face_A_Plat Then
2029     ' If Not lst_face.Contains(interFF.sFaceVolume) Then
2030     ' lst_face.Add(interFF.sFaceVolume)
2031     ' interFF.DécouperFace_A_Plat()
2032     ' End If
2033    
2034    
2035 bournival 40 If interFF.FaceDeSection Then
2036     CoupeCoque1(interFF)
2037 bournival 130 If Not Intersections.MultiDecoupageCoques Then interFF.MarquerFacesInternes()
2038 bournival 40 Else
2039 bournival 130
2040     If interFF.DoitCouperCoque Then
2041 bournival 40 interFF.DecouperCoque()
2042 bournival 130 interFF.QuelleAreteCoqueToucheVolume()
2043 bournival 40 End If
2044 bournival 130 interFF.DécouperVolume()
2045     If Not Intersections.MultiDecoupageCoques Then interFF.MarquerFacesInternes() ' étape 6
2046 bournival 40
2047     End If
2048 bournival 130 Next interFF
2049 bournival 40 Next coque1
2050    
2051    
2052     End Sub
2053    
2054    
2055    
2056     ''' <summary>
2057     ''' Lorsque la coque est modélisée en partie par un morceau de volume. Dessine et coupe.
2058     ''' </summary>
2059     ''' <param name="int">L'interFaceFace</param>
2060     ''' <remarks></remarks>
2061     Private Sub CoupeCoque1(ByRef int As InterCoqueVolume)
2062     Dim sVol As SlyFaceVolume
2063     Dim swFace As SldWorks.Face2
2064     Dim swent As SldWorks.Entity
2065     Dim sketch As SldWorks.Sketch
2066     Dim vEdges As Object
2067     Dim swArete As SldWorks.Edge
2068     Dim aretes() As SldWorks.Edge = Nothing
2069     Dim i As Integer
2070    
2071     ' a - prendre la face du volume
2072     sVol = int.sFaceVolume
2073     swFace = sVol.SwFace
2074     sVol.Selectionner(0, False)
2075    
2076 bournival 130 '' b - lui mettre une esquisse
2077     'swModel.InsertSketch2(True)
2078 bournival 40
2079 bournival 130 '' c - convertir l'esquisse déjà créée
2080     'sketch = int.sketch
2081     'swent = sketch
2082     'swent.Select2(False, 0)
2083 bournival 40
2084 bournival 130 'swModel.SketchUseEdge2(False)
2085 bournival 40
2086 bournival 130 '' si la face est carrée
2087 bournival 40
2088 bournival 130 'If swFace.GetEdgeCount = 4 Then
2089     ' ' d - ajouter des lignes pour compléter l'esquisse
2090     ' Dim longueur(3) As Double
2091 bournival 40
2092    
2093 bournival 130 ' Dim vLine As Object
2094     ' Dim line1 As SldWorks.SketchLine, line2 As SldWorks.SketchLine
2095     ' Dim P1 As SldWorks.SketchPoint, P2 As SldWorks.SketchPoint, P3 As SldWorks.SketchPoint, P4 As SldWorks.SketchPoint
2096     ' Dim skSeg As SldWorks.SketchSegment
2097     ' vEdges = swFace.GetEdges()
2098     ' For Each swArete In vEdges
2099     ' ReDim Preserve aretes(i)
2100     ' aretes(i) = swArete
2101     ' i += 1
2102     ' Next
2103     ' For i = 0 To 3
2104     ' longueur(i) = Commun.GetLongueurArete(vEdges(i))
2105     ' Next i
2106     ' longueur = Ordonner(longueur, aretes)
2107 bournival 40
2108 bournival 130 ' swent = aretes(3) : swent.Select2(False, 0) ' on prend la plus grande arète
2109     ' swModel.SketchUseEdge2(False)
2110     ' sketch = swModel.GetActiveSketch()
2111     ' vLine = sketch.GetSketchSegments()
2112     ' skSeg = vLine(0) : line1 = skSeg
2113     ' skSeg = vLine(1) : line2 = skSeg
2114 bournival 40
2115 bournival 130 ' P1 = line1.GetStartPoint2()
2116     ' P2 = line1.GetEndPoint2()
2117     ' P3 = line2.GetStartPoint2()
2118     ' P4 = line2.GetEndPoint2()
2119 bournival 40
2120 bournival 130 ' If Distance(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z) < Distance(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z) Then ' ligne entre 1 et 3
2121     ' swModel.CreateLine2(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z)
2122     ' swModel.CreateLine2(P2.X, P2.Y, P2.Z, P4.X, P4.Y, P4.Z)
2123     ' Else ' ligne entre 1 et 4 & 2 et 3
2124     ' swModel.CreateLine2(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z)
2125     ' swModel.CreateLine2(P2.X, P2.Y, P2.Z, P3.X, P3.Y, P3.Z)
2126     ' End If
2127     'Else
2128     ' sketch = swModel.GetActiveSketch()
2129     'End If
2130     'swModel.InsertSketch2(True)
2131 bournival 40
2132    
2133 bournival 130 '' e - splitter
2134     'swent = swFace : swent.Select2(False, 1)
2135     'swent = sketch : swent.Select2(True, 4)
2136     'swModel.InsertSplitLineProject(False, False)
2137 bournival 40
2138    
2139 bournival 130 sVol.Selectionner(32, False) 'swPart.Extension.SelectByID2("", "FACE", 0.05746341258515, 0.007456177698316, 0.04437034503314, False, 16, Nothing, 0)
2140     int.sFaceCoque.Selectionner(16, True) 'swPart.Extension.SelectByID2("", "FACE", 0.03921396269902, -0.007016448377556, 0, True, 32, Nothing, 0)
2141     swPart.FeatureManager.InsertSplitLineIntersect(7)
2142    
2143 bournival 40 ' f - mettre un FaceInterne sur les 2 faces résultantes.
2144     Dim swFeat As SldWorks.Feature
2145     Dim vFace As Object
2146     Dim swFace1 As SldWorks.Face2, swFace2 As SldWorks.Face2
2147     Dim attr As SldWorks.Attribute
2148     Dim nom As String
2149     Dim no As Long
2150     swFeat = swModel.FeatureByPositionReverse(0)
2151     vFace = swFeat.GetFaces
2152    
2153     swFace1 = vFace(0)
2154     swFace2 = vFace(1)
2155    
2156 bournival 130 sVol.AjouterFace(swFace1)
2157     sVol.AjouterFace(swFace2)
2158 bournival 40
2159 bournival 130 'Dim eFace As New SlyFaceVolume(swFace1, True)
2160     'eFace.MettreAttributFaceInterne(swFace1, , False)
2161 bournival 40
2162 bournival 130 'swent = swFace1
2163     'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2164     'nom = "FaceInterneCoque1"
2165     'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2) ' 0 = swThisconfig
2166 bournival 40
2167 bournival 130 'While attr Is Nothing
2168     ' no += 1
2169     ' nom = "FaceInterneCoque" & CStr(no)
2170     ' attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2)
2171     'End While
2172     'GererDossiers("FaceInternes", nom)
2173 bournival 40
2174 bournival 130 'swent = swFace2
2175     'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2176     'nom = "FaceInterneCoque1"
2177     'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2) ' 0 = swThisconfig
2178 bournival 40
2179 bournival 130 'While attr Is Nothing
2180     ' no += 1
2181     ' nom = "FaceInterneCoque" & CStr(no)
2182     ' attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2)
2183     'End While
2184     'GererDossiers("FaceInternes", nom)
2185    
2186    
2187 bournival 40 End Sub
2188    
2189    
2190     ''' <summary>
2191     ''' Détecte s'il y a une intersection entre une coque et une face d'un volume
2192     ''' </summary>
2193     ''' <param name="sFaceCoque"></param>
2194     ''' <param name="sFaceVolume"></param>
2195     ''' <param name="dessiner">Si oui, alors on dessine une ligne à l'intersection</param>
2196     ''' <param name="sketch">Si dessiner est vrai, alors ce sketch contient la ligne d'intersection</param>
2197     ''' <returns>Vrai s'il y a une intersection</returns>
2198     ''' <remarks></remarks>
2199     Private Function DetectFaceFace(ByRef sFaceCoque As SlyFaceCoque, ByRef sFaceVolume As SlyFaceVolume, Optional ByRef dessiner As Boolean = False, Optional ByRef sketch As SldWorks.Sketch = Nothing) As Boolean
2200     For Each swfc As SldWorks.Face2 In sFaceCoque.lst_Faces
2201     For Each swFV As SldWorks.Face2 In sFaceVolume.lst_Faces
2202     If DetectFaceFace(swfc, swFV, dessiner, sketch) Then Return True
2203     Next
2204     Next
2205     End Function
2206    
2207    
2208     ''' <summary>
2209     ''' Function qui retourne vrai ou faux si 2 FACES (pas surfaces) se touchent. La routine finit par appeler la sub dessinecourbe pour dessiner la courbe.
2210     ''' </summary>
2211     ''' <param name="face1">Première face</param>
2212     ''' <param name="face2">Seconde face</param>
2213     ''' <param name="dessiner">Si l'on veut dessiner une esquisse contenant la courbe</param>
2214 bournival 130 ''' <param name="Sketch">Si la précédente option est vrai, ce paramètre redonne l'esquisse qui contient la courbe (peut contenir plusieurs segments) d'intersection</param>
2215 bournival 40 ''' <returns>Vrai si les faces se touchent</returns>
2216     ''' <remarks>Si les 2 faces se touchent en un seul point alors ça retourne faux.</remarks>
2217     Private Function DetectFaceFace(ByRef face1 As SldWorks.Face2, ByRef face2 As SldWorks.Face2, Optional ByRef dessiner As Boolean = False, Optional ByRef Sketch As SldWorks.Sketch = Nothing) As Boolean
2218 bournival 130 'sub qui détecte si 2 faces se touchent et retourne vrai si c'est le cas.
2219     Dim Surface1 As sldworks.Surface
2220     Dim Surface2 As sldworks.Surface
2221 bournival 40 Dim curveArray As Object = Nothing
2222 bournival 130 Dim curve As sldworks.Curve
2223 bournival 40 Dim ret As Boolean
2224     Dim boundsArray As Object = Nothing
2225     Dim bounds() As Double
2226     Dim Point1(2) As Double
2227     Dim Point2(2) As Double
2228     Dim P1 As Object = Nothing, P2 As Object = Nothing
2229     Dim ClosestDist As Double
2230    
2231     Surface1 = face1.GetSurface
2232     Surface2 = face2.GetSurface
2233    
2234     ClosestDist = swModel.ClosestDistance(face1, face2, P1, P2)
2235     If ClosestDist > (Epsilon * 10) Then Return False
2236    
2237     ' curvearray est un tableau de curves, boundsarray est un tableau de T des limites de la courbe
2238     ret = Surface1.IntersectSurface(Surface2, curveArray, boundsArray) ' si c'est une ligne, retourne une ligne infinie...
2239     ' il faut alors renvoyer vers le detectFaceArete()
2240     If Not ret Then Return False
2241     bounds = boundsArray
2242    
2243     Try
2244     curve = curveArray(0)
2245     Catch
2246 bournival 130
2247     'MsgBox("On a une intersection où 2 faces sont sur la même surface...") ' en théorie...
2248     Return True ' ouch... pas certain.
2249 bournival 40 End Try
2250    
2251    
2252     If Not curve.IsLine Then ' si c'est une ligne, alors le principe de longueur ne fonctionnera pas...
2253     Dim longueur As Double = curve.GetLength2(bounds(0), bounds(1))
2254     If longueur < Epsilon Then Return False ' on a juste un point d'intersection
2255     Else
2256     Dim vParam As Object
2257     vParam = curve.GetClosestPointOn(P1(0), P1(1), P1(2)) ' vparam(3) est le U
2258    
2259 bournival 130 P1 = curve.Evaluate(vParam(3) + 100000 * Epsilon) : Point1(0) = P1(0) : Point1(1) = P1(1) : Point1(2) = P1(2)
2260     P2 = curve.Evaluate(vParam(3) - 100000 * Epsilon) : Point2(0) = P2(0) : Point2(1) = P2(1) : Point2(2) = P2(2)
2261 bournival 40
2262 bournival 130 ' si p1 et p2 sont identiques alors on a un point D'intersection, ce que l'on ne veut pas
2263     If Distance(Point1, Point2) < 1000 * Epsilon Then Return False
2264    
2265     If ((Distance(face1, Point1(0), Point1(1), Point1(2)) < (1000 * Epsilon)) AndAlso (Distance(face2, Point1(0), Point1(1), Point1(2)) < (1000 * Epsilon))) OrElse ((Distance(face1, Point2(0), Point2(1), Point2(2)) < (Epsilon * 1000)) AndAlso (Distance(face2, Point2(0), Point2(1), Point2(2)) < (1000 * Epsilon))) Then
2266     ' return true
2267 bournival 40 Else
2268 bournival 130 Dim swent2 As sldworks.Entity
2269     Dim feat2 As sldworks.Feature
2270     swModel.Insert3DSketch2(False)
2271     swModel.ClearSelection2(True)
2272     swent2 = face1 : swent2.Select2(False, 0)
2273     swent2 = face2 : swent2.Select2(True, 0)
2274     swModel.Sketch3DIntersections()
2275    
2276     swModel.Insert3DSketch2(False)
2277     swModel.EditRebuild3()
2278     feat2 = swModel.FeatureByPositionReverse(0)
2279    
2280     Sketch = feat2.GetSpecificFeature2
2281     feat2.Name = "TouchePas" & CStr(Rnd())
2282     Dim vSeg2 As Object = Sketch.GetSketchSegments()
2283     If vSeg2 Is Nothing Then
2284     swent2 = feat2
2285     swent2.Select(False)
2286     swModel.EditDelete()
2287     Return False
2288     Else
2289     Return True
2290     End If
2291 bournival 40 End If
2292     End If
2293    
2294 bournival 130 Dim swent As sldworks.Entity
2295     Dim feat As sldworks.Feature
2296     swModel.Insert3DSketch2(False)
2297     swModel.ClearSelection2(True)
2298     swent = face1 : swent.Select2(False, 0)
2299     swent = face2 : swent.Select2(True, 0)
2300     swModel.Sketch3DIntersections()
2301 bournival 40
2302 bournival 130 swModel.Insert3DSketch2(False)
2303     swModel.EditRebuild3()
2304     feat = swModel.FeatureByPositionReverse(0)
2305 bournival 40
2306 bournival 130 Sketch = feat.GetSpecificFeature2
2307     Dim vSeg As Object = Sketch.GetSketchSegments()
2308     If vSeg Is Nothing Then
2309     swent = feat
2310     swent.Select(False)
2311     swModel.EditDelete()
2312     Return False
2313     Else
2314     Return True
2315 bournival 40 End If
2316    
2317     Return True
2318    
2319     End Function
2320    
2321    
2322     Public Function trier(ByRef lst() As Double) As Double()
2323     ' sub qui retourne les T min et T max en fonction de la collection.
2324     ' normalement on enlève les 2 points max et min et il devrait nous rester un nombre pair de valeurs.
2325     Dim i As Integer, j As Integer
2326     Dim lst2() As Double
2327    
2328     Dim temp As Double
2329    
2330     If UBound(lst) < 1 Then Return Nothing
2331    
2332     For j = 0 To UBound(lst) - 1
2333     For i = 0 To UBound(lst) - j - 1
2334     If lst(i) > lst(i + 1) Then
2335     temp = lst(i)
2336     lst(i) = lst(i + 1)
2337     lst(i + 1) = temp
2338     End If
2339     Next i
2340     Next j
2341    
2342     ReDim lst2(UBound(lst) - 2)
2343     For i = 1 To UBound(lst) - 1
2344     lst2(i - 1) = lst(i)
2345     Next
2346     Return lst2
2347    
2348    
2349    
2350     End Function
2351    
2352     ''' <summary>
2353     ''' Function qui remet en ordre croissant les valeurs d'un tableau
2354     ''' </summary>
2355     ''' <param name="lst">Le tableau de valeurs à ordonner</param>
2356     ''' <param name="liste2">un second tableau que l'on peut ordonner</param>
2357     ''' <returns></returns>
2358     ''' <remarks></remarks>
2359     Public Function Ordonner(ByRef lst() As Double, Optional ByRef liste2() As SldWorks.Edge = Nothing) As Double()
2360    
2361     Dim i As Integer, j As Integer
2362     Dim temp2 As Object
2363    
2364     Dim temp As Double
2365    
2366     If UBound(lst) < 1 Then Return Nothing
2367    
2368     For j = 0 To UBound(lst) - 1
2369     For i = 0 To UBound(lst) - j - 1
2370     If lst(i) > lst(i + 1) Then
2371     temp = lst(i)
2372     lst(i) = lst(i + 1)
2373     lst(i + 1) = temp
2374     If Not liste2 Is Nothing Then
2375     temp2 = liste2(i)
2376     liste2(i) = liste2(i + 1)
2377     liste2(i + 1) = temp2
2378     End If
2379    
2380     End If
2381     Next i
2382     Next j
2383    
2384     Return lst
2385    
2386    
2387    
2388     End Function
2389    
2390    
2391 bournival 130 ''' <summary>
2392     ''' Sub qui fait comme le tavail de Antoine et Rémi et qui créé un fichier pour la carte de taille. Si l'option de pré-optimisation est enclenchée, la sub ne fait qu'ajouter des éléments au fichier .txt
2393     ''' </summary>
2394     ''' <remarks></remarks>
2395     Public Sub FairePreCarte()
2396 bournival 40
2397 bournival 130 Dim ligne_txt As String
2398     Dim fichier As System.IO.StreamWriter
2399     Dim EcartNodal As Double = Commun.ÉcartNodal
2400 bournival 40
2401 bournival 130 ' si le fichier pog n'est pas encore créé, on doit le faire...
2402     If Commun.NomFichierPog = Nothing Then
2403     ' la première ligne donne la boite englobante, la seconde la taille ENG
2404    
2405     Dim path As String = Nothing
2406     Dim CMDialogl As New Windows.Forms.SaveFileDialog
2407     CMDialogl.DefaultExt = ".txt"
2408     CMDialogl.Filter = "Fichiers PoG (*.txt)|*.txt|Tout fichiers(*.*)|*.*"
2409    
2410     CMDialogl.OverwritePrompt = True
2411     CMDialogl.Title = "Sélectionnez le fichier pour enregistrer les points"
2412     CMDialogl.ShowDialog()
2413     path = CMDialogl.FileName
2414     path = Txtpath(path) : Commun.NomFichierPog = path
2415     If path Is Nothing Or path = "" Then MsgBox("Aucun fichier sélectionné, sortie du programme!", MsgBoxStyle.Critical, "Erreur!")
2416    
2417     fichier = System.IO.File.CreateText(path)
2418    
2419     Dim vBox As Object = swPart.GetPartBox(True)
2420     Dim box() As Double = vBox
2421    
2422     Dim centre(2) As Double ' le centre de la boite englobante
2423     Dim longueurs(2) As Double
2424    
2425     centre(0) = (box(3) + box(0)) / 2
2426     centre(1) = (box(4) + box(1)) / 2
2427     centre(2) = (box(5) + box(2)) / 2
2428    
2429     longueurs(0) = (box(3) - box(0)) * 1.25
2430     longueurs(1) = (box(4) - box(1)) * 1.25
2431     longueurs(2) = (box(5) - box(2)) * 1.25
2432    
2433    
2434     ligne_txt = CStr(centre(0) - longueurs(0) / 2) & " " & CStr(centre(1) - longueurs(1) / 2) & " " & CStr(centre(2) - longueurs(2) / 2) & " " & CStr(centre(0) + longueurs(0) / 2) & " " & CStr(centre(1) + longueurs(1) / 2) & " " & CStr(centre(2) + longueurs(2) / 2)
2435     fichier.WriteLine(Replace(ligne_txt, ",", "."))
2436    
2437     fichier.WriteLine(Replace(CStr(EcartNodal), ",", "."))
2438     Else
2439     ' Le fichier pog existe déjà...
2440     fichier = System.IO.File.AppendText(Commun.NomFichierPog)
2441     'fichier.WriteLine(Replace(CStr(EcartNodal), ",", "."))
2442     End If
2443    
2444    
2445     ' *** C'est ici que le fun se passe.
2446    
2447    
2448     ' 1 - On parcourt toutes les faces, les listes sont déjà RE-crées, donc pas de multifaces
2449     For Each sFace As SlyFaceVolume In Commun.lst_FaceVolume
2450     sFace.MettrePointSurPOG(fichier)
2451     Next
2452    
2453    
2454    
2455     ' *** Fin
2456     fichier.Close()
2457     End Sub
2458    
2459     ''' <summary>
2460     ''' Fonction qui compare 2 surfaces
2461     ''' </summary>
2462     ''' <param name="swSurf1">La première surface</param>
2463     ''' <param name="swSurf2">La seconde</param>
2464     ''' <returns>Vrai si les 2 surfaces sont identiques, faux sinon</returns>
2465     ''' <remarks></remarks>
2466     Public Function ComparerSurfaces(ByRef swSurf1 As sldworks.Surface, ByRef swSurf2 As sldworks.Surface) As Boolean
2467     'swSurf1.GetBSurfParams2(True,False,
2468    
2469    
2470     If swSurf1.IsPlane And swSurf2.IsPlane Then
2471     Dim obj1 As Object = swSurf1.PlaneParams
2472     Dim obj2 As Object = swSurf2.PlaneParams
2473     For i As Integer = 0 To 2
2474     If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2475     Next
2476     Return True
2477     ElseIf swSurf1.IsBlending And swSurf2.IsBlending Then
2478     ' pas de blendingParams
2479    
2480     ElseIf swSurf1.IsCone And swSurf2.IsCone Then
2481     Dim obj1 As Object = swSurf1.ConeParams
2482     Dim obj2 As Object = swSurf2.ConeParams
2483     For i As Integer = 0 To 7
2484     If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2485     Next
2486     Return True
2487    
2488     ElseIf swSurf1.IsCylinder And swSurf2.IsCylinder Then
2489     Dim obj1 As Object = swSurf1.CylinderParams
2490     Dim obj2 As Object = swSurf2.CylinderParams
2491     For i As Integer = 0 To 6
2492     If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2493     Next
2494     Return True
2495     ElseIf swSurf1.IsForeign And swSurf2.IsForeign Then
2496     ' ???
2497     ElseIf swSurf1.IsOffset And swSurf2.IsOffset Then
2498     ' Pas de offsetParam
2499    
2500     ElseIf swSurf1.IsParametric And swSurf2.IsParametric Then
2501     ' pas de ParametricParams
2502    
2503     ElseIf swSurf1.IsRevolved And swSurf2.IsRevolved Then
2504     ' pas de revolvedparams
2505    
2506     ElseIf swSurf1.IsSphere And swSurf2.IsSphere Then
2507     Dim obj1 As Object = swSurf1.SphereParams
2508     Dim obj2 As Object = swSurf2.SphereParams
2509    
2510     For i As Integer = 0 To 3
2511     If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2512     Next
2513     Return True
2514     ElseIf swSurf1.IsSwept And swSurf2.IsSwept Then
2515     ' merde, il n'y a pas de Sweptparams
2516    
2517     ElseIf swSurf1.IsTorus And swSurf2.IsTorus Then
2518     Dim obj1 As Object = swSurf1.TorusParams
2519     Dim obj2 As Object = swSurf2.TorusParams
2520    
2521     For i As Integer = 0 To 7
2522     If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2523     Next
2524     Return True
2525     Else
2526     ' faut quand même évaluer si on a la bonne chose...
2527     Dim obj As Object = swSurf1.GetClosestPointOn(0, 0, 0) ' x, y , z, U, V
2528    
2529     Dim obj1 As Object = swSurf1.EvaluateAtPoint(obj(0), obj(1), obj(2))
2530     Dim obj2 As Object = swSurf1.EvaluateAtPoint(obj(0), obj(1), obj(2))
2531    
2532     If Math.Abs(obj1(9) - obj2(9)) < Epsilon And Math.Abs(obj1(10) - obj2(10)) < Epsilon Then
2533     ' c'est cheap.... mais
2534     Return True
2535     End If
2536     Return False
2537    
2538     End If
2539    
2540     Return False
2541    
2542    
2543    
2544     End Function
2545    
2546    
2547 bournival 40 End Module