ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterCoqueVolume.vb
Revision: 130
Committed: Wed Jul 30 21:26:03 2008 UTC (16 years, 9 months ago) by bournival
File size: 34180 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 ''' <summary>
6     ''' Classe qui mémorise l'intersection entre une face d'un volume et une facecoque.
7     ''' </summary>
8     ''' <remarks>Même s'il y aplusieurs intersections distinctes entre les 2 faces, il n'y a qu'une seule classe de créée</remarks>
9     Public Class InterCoqueVolume
10     Inherits InterFaceFace
11    
12    
13     Public sFaceCoque As SlyFaceCoque 'SlyFaceCoque ou slyfaceVol
14     Public sFaceVolume As SlyFaceVolume 'SlyFaceCoque ou slyfaceVol
15    
16     Public AreteVolume As SldWorks.Edge ' l'arrète de la face1 (volume si coque-volume)
17     Public AreteCoque As SldWorks.Edge ' l'arrète de la face2
18    
19     Private PointQuiTouche() As Double = {-999, -9999, -99999}
20 bournival 130
21     ''' <summary>
22     ''' Ne me souviens plus.
23     ''' </summary>
24     ''' <remarks></remarks>
25 bournival 40 Public DerniereCoupe As Boolean = False
26    
27 bournival 130
28    
29    
30 bournival 40 ''' <summary>
31     ''' Quand on a une intersection coque-volume avec face de section, il faut trouver quelle arète de la coque touche au volume
32     ''' </summary>
33     ''' <param name="GuideSweep">Si oui alors on utilise le sweep pour se guider, utile dans le cas #1</param>
34     ''' <remarks></remarks>
35 bournival 130 Public Function QuelleAreteCoqueToucheVolume(Optional ByVal GuideSweep As Boolean = False) As sldworks.Edge
36     Dim aretes() As sldworks.Edge
37     Dim Sommet1 As sldworks.Vertex
38     Dim sommet2 As sldworks.Vertex
39 bournival 40 Dim z As Integer
40 bournival 130 Dim P1 As Object
41 bournival 40
42    
43     'Dim swFace() As SldWorks.Face2 = sFaceCoque.DonnerFaces ' attention, pas juste une face.....
44 bournival 130
45 bournival 40 aretes = sFaceCoque.GetAretes()
46 bournival 130 Dim swFaceVol() As sldworks.Face2 = Me.sFaceVolume.GetFaces
47 bournival 40
48    
49 bournival 130 For Each swFaceV As sldworks.Face2 In swFaceVol
50    
51 bournival 40 For z = 0 To UBound(aretes)
52     Sommet1 = aretes(z).GetStartVertex()
53 bournival 130 If swModel.ClosestDistance(swFaceV, aretes(z), P1, Nothing) < Epsilon Then
54     If Sommet1 Is Nothing Then ' on a un cercle...
55     'Dim params As Object
56     'params = aretes(z).Evaluate(0.5) ' 0.5 pour ne pas être à 0, ni 1, ni 3.14. Pour être très méticuleux il faudrait vérifier 2 points...
57     'If Distance(swFaceV, params(0), params(1), params(2)) < Epsilon Then AreteCoque = aretes(z) : Return Me.AreteCoque
58     Dim sAreteCoque As New SuperArete(aretes(z), True)
59     Dim g As Integer = 0
60     Dim pointTest(2) As Double
61     Dim Tmin As Double = sAreteCoque.GetTMin
62     Dim Tmax As Double = sAreteCoque.GetTMax
63     Dim incrT As Double = (Tmax - Tmin) / 20
64    
65     While g < 20
66     sAreteCoque.Evaluer(Tmin + g * incrT, pointTest)
67     If Commun.Distance(swFaceV, pointTest(0), pointTest(1), pointTest(2)) > 0.000001 Then Continue For ' merde, je déteste cette façon de procéder!
68     g += 1
69     End While
70     AreteCoque = aretes(z) : Return Me.AreteCoque
71    
72     Else
73     sommet2 = aretes(z).GetEndVertex()
74     If Commun.Distance(swFaceV, Sommet1) < (10000 * Epsilon) AndAlso Distance(swFaceV, sommet2) < (10000 * Epsilon) Then
75     If GuideSweep Then ' on doit EN PLUS vérifier que le sweep touche à la courbe
76     If swModel.ClosestDistance(Me.BodySweep, Sommet1, Nothing, Nothing) < Epsilon AndAlso swModel.ClosestDistance(Me.BodySweep, sommet2, Nothing, Nothing) < Epsilon Then AreteCoque = aretes(z) : Return Me.AreteCoque
77     Else ' ok automatiquement
78     AreteCoque = aretes(z) : Return AreteCoque
79     End If
80 bournival 40 End If
81     End If
82     End If
83     Next z
84     Next swFaceV
85    
86 bournival 130 Return Nothing
87 bournival 40
88 bournival 130 ' si aucun sommet ne touche, mais on a une partie de la courbe qui touche, i.e. on dépasse de chaque coté.
89     ' le sweep touche à juate une arète (sauf si la coque est fuckée près du point d'intersection)
90    
91    
92    
93 bournival 40 ' si on est ici c'est qu'une arète de la coque ne repose pas entièrement sur une seule face du volume, juste un de ses sommet...
94 bournival 130 'DerniereCoupe = True
95     'Dim PointNext(2) As Double
96     'Dim eArete As SuperArete
97     'For Each swFaceV As SldWorks.Face2 In swFaceVol
98     ' For z = 0 To UBound(aretes)
99     ' Sommet1 = aretes(z).GetStartVertex()
100     ' eArete = New SuperArete(aretes(z), True)
101     ' eArete.Evaluer(eArete.GetTMin + 10 * Epsilon, PointNext)
102     ' 'Commun.MettreUnPoint(PointNext(0), PointNext(1), PointNext(2))
103     ' If Commun.Distance(swFaceV, Sommet1) < Epsilon AndAlso Commun.Distance(swFaceV, PointNext(0), PointNext(1), PointNext(2)) < Epsilon Then AreteCoque = aretes(z) : Me.PointQuiTouche = PointNext : Exit Sub
104 bournival 40
105 bournival 130 ' sommet2 = aretes(z).GetEndVertex()
106     ' eArete = New SuperArete(aretes(z), True)
107     ' eArete.Evaluer(eArete.GetTMax - 10 * Epsilon, PointNext)
108     ' 'Commun.MettreUnPoint(PointNext(0), PointNext(1), PointNext(2))
109     ' 'eArete.Colorer(z, z / 4, z / 4, z / 4)
110     ' If Commun.Distance(swFaceV, sommet2) < Epsilon AndAlso Commun.Distance(swFaceV, PointNext(0), PointNext(1), PointNext(2)) < Epsilon Then AreteCoque = aretes(z) : Me.PointQuiTouche = PointNext : Exit Sub
111     ' Next z
112     'Next swFaceV
113 bournival 40
114 bournival 130 'MsgBox("la bonne arète n'a pas été trouvée" & vbCr & eArete.ToString)
115 bournival 40
116    
117 bournival 130 End Function
118 bournival 40
119    
120     ''' <summary>
121     ''' Sub qui dessine le sweep à l'endroit d'intersection
122     ''' </summary>
123 bournival 130 ''' <remarks>Attention, fixe la propriété Me.BodySweep</remarks>
124 bournival 40 Public Sub GénérerSweep(Optional ByRef sketch As SldWorks.Sketch = Nothing)
125     ' on peut essayer 2 méthodes, celle du offset des faces et celle du sweep d'un cercle
126     ' celle du offset ne marche pas dans toutes les circonstances...
127     Dim swEnt As SldWorks.Entity
128    
129     If sketch Is Nothing Then
130     If Me.AreteCoque Is Nothing Then Me.QuelleAreteCoqueToucheVolume()
131     ' on ignore le sketch pour l'instant, et on recréé un nouveau sketch qui convertit l'arète de la coque
132     swModel.Insert3DSketch2(False)
133     swEnt = Me.AreteCoque : swEnt.Select4(False, Nothing)
134     Dim skManager As SldWorks.SketchManager = swModel.SketchManager
135     skManager.SketchUseEdge(False)
136     ' ici on doit le prolonger si besoin est
137    
138     sketch = swModel.GetActiveSketch2()
139     swModel.Insert3DSketch2(False)
140     End If
141    
142    
143    
144     ' technique du sweep du cercle
145     ' 1 - trace de la ligne d'intersection
146     ' en théorie c'est déjà fait et on a interFF.sketch qui a le sketch d'intersection...
147    
148     ' 2- Placer un plan à l'extrémité
149     Dim Plan As SldWorks.RefPlane
150    
151     Dim vSeg As Object 'SldWorks.SketchSegment
152     Dim seg As SldWorks.SketchSegment
153     Dim skPoint As SldWorks.SketchPoint = Nothing
154    
155    
156     vSeg = sketch.GetSketchSegments() : seg = vSeg(0)
157    
158     Select Case seg.GetType ' faut faire attention, si le sketch est fermé, ça peut chier des taque pour séelectionner le point
159     Case SwConst.swSketchSegments_e.swSketchLINE
160     Dim skline As SldWorks.SketchLine = seg
161     skPoint = skline.GetStartPoint2()
162    
163     Case SwConst.swSketchSegments_e.swSketchARC
164     Dim skarc As SldWorks.SketchArc = seg
165     skPoint = skarc.GetStartPoint2()
166     Case SwConst.swSketchSegments_e.swSketchELLIPSE
167     Dim skellipse As SldWorks.SketchEllipse = seg
168     skPoint = skellipse.GetStartPoint2()
169     If skPoint Is Nothing Then
170     ' couper l'ellipse
171     MsgBox("On a pas de startpoint sur cette ellipse")
172     End If
173     Case SwConst.swSketchSegments_e.swSketchSPLINE
174     Dim skSpline As SldWorks.SketchSpline = seg
175     Dim vPoints As Object
176     vPoints = skSpline.GetPoints2()
177     skPoint = vPoints(0)
178     Case SwConst.swSketchSegments_e.swSketchPARABOLA
179     Dim skPara As SldWorks.SketchParabola = seg
180     skPoint = skPara.GetStartPoint2()
181     Case Else
182     MsgBox(" Là y'a un problème! (case else....)")
183     End Select
184    
185     seg.Select4(False, Nothing)
186     skPoint.Select4(True, Nothing)
187    
188     Plan = swModel.CreatePlanePerCurveAndPassPoint3(True, False) ' le premier true met l'origine sur le point de la courbe, le second false est pour la visualisation.
189    
190     ' 3 - on créé un cercle sur le plan
191     Dim rayon As Double
192     Dim sface As SlyFaceCoque = Me.sFaceCoque
193     Dim feat As SldWorks.Feature
194     Dim sketchCercle As SldWorks.Sketch
195    
196     rayon = sface.GetEpaisseur
197     swEnt = Plan : swEnt.Select4(False, Nothing)
198    
199     swModel.InsertSketch2(False)
200 bournival 130 swModel.CreateCircleByRadius2(0, 0, 0, rayon / 2)
201 bournival 40 swModel.InsertSketch2(True)
202    
203     feat = swModel.FeatureByPositionReverse(0)
204     sketchCercle = feat.GetSpecificFeature2()
205    
206     ' 4 - Sweep
207     Dim swFeatManager As SldWorks.FeatureManager = swModel.FeatureManager
208    
209     Dim merge As Boolean = False
210    
211     swEnt = sketchCercle : swEnt.Select2(False, 1)
212     swEnt = sketch : swEnt.Select2(True, 4)
213    
214     feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, 1, 1, False, 0, 0, 0, 0, merge, 1, 1, 0, 1) ' merge fait additionner le bnouveau corps... Pas certain du false qui suit.
215    
216     If feat Is Nothing Then
217     swEnt = sketchCercle : swEnt.Select2(False, 1)
218     swEnt = sketch : swEnt.Select2(True, 4)
219     feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, 0, 0, False, 0, 0, 0, 0, 0, 1, 1, 0, 1)
220     End If
221    
222     If feat Is Nothing Then
223     ' il est possible que la coque soit une spline
224     MsgBox("Il est impossible de découper la forme de la courbe, la coque est trop repliée sur elle-même..." & vbCr & "Un rayon de courbure de la section de la coque est inférieur à l'épaisseur de la coque", MsgBoxStyle.Information, "Impossible de découper à un endroit!")
225     ' on pourrait éventuellement appliquer une autre méthode.
226     Exit Sub
227     End If
228    
229     Dim vfaces As Object = feat.GetFaces
230     Dim swface As SldWorks.Face2 = vfaces(0)
231     Me.BodySweep = swface.GetBody
232    
233    
234     If Me.BodySweep Is Nothing Then MsgBox(feat.Name)
235    
236     End Sub
237    
238    
239 bournival 130 ''' <summary>
240     ''' Pour simplifier l'écriture de DécouperVolume. Cette sub découpe le volume (ou l'autre coque) à plusieurs endroits pour y placer des mini-poutres orientées et perpendiculaires
241     '''
242     ''' </summary>
243     ''' <remarks></remarks>
244     Private Sub MultiDecoupage()
245 bournival 46
246 bournival 130 ' 1 - le segment
247     Dim vseg As Object = Me.sketch.GetSketchSegments
248     Dim swEnt As sldworks.Entity
249     Dim PetitSketch As sldworks.Sketch = Nothing
250     Dim swSketchManager As sldworks.SketchManager = swModel.SketchManager
251     Dim sfaceVol As SlyFaceVolume ' la face du volume
252     Dim swfaceVol As sldworks.Face2
253    
254    
255     ' a- on fait un plus petit balayage
256     Dim curve As sldworks.Curve
257     Dim longueur As Double
258     Dim nb As Integer
259     Dim epaisseurCoque As Double = Me.sFaceCoque.GetEpaisseur
260     Dim T, Tmin, interval As Double
261     Dim skfin As sldworks.SketchPoint
262     Dim xyz(2) As Double
263     Dim featmanager As sldworks.FeatureManager = swModel.FeatureManager
264    
265    
266    
267     For Each segment As sldworks.SketchSegment In vseg
268     curve = segment.GetCurve()
269     Dim courbe As New SuperCourbe(curve)
270     longueur = segment.GetLength
271    
272     nb = CInt(longueur / (epaisseurCoque / 2)) : If nb = 0 Then nb = 1
273    
274    
275     If Not segment.GetType = swconst.swSketchSegments_e.swSketchLINE Then
276     'T = courbe.GetTMin : interval = (courbe.GetTMax - courbe.GetTMin) / nb
277     MsgBox("le segment n'est pas une droite, pas encore programmé")
278     'fin(0) = doit être défini pour la sélection
279     Else
280     ' on a un segment droit...
281     Dim lineseg As sldworks.SketchLine = segment
282     Dim skDebut As sldworks.SketchPoint = lineseg.GetStartPoint2()
283     skfin = lineseg.GetEndPoint2()
284     xyz(0) = skDebut.X + (skfin.X - skDebut.X) / nb
285     xyz(1) = skDebut.Y + (skfin.Y - skDebut.Y) / nb
286     xyz(2) = skDebut.Z + (skfin.Z - skDebut.Z) / nb
287    
288     End If
289    
290     swModel.Insert3DSketch()
291     segment.Select4(False, Nothing)
292     swModel.SketchUseEdge2(False)
293     swModel.ClearSelection2(True)
294     swModel.Extension.SelectByID2("", "SKETCHSEGMENT", xyz(0), xyz(1), xyz(2), False, 0, Nothing, 0)
295     swModel.SplitOpenSegment(xyz(0), xyz(1), xyz(2))
296     'swModel.CreatePoint2(xyz(0), xyz(1), xyz(2))
297     'swModel.SplitOpenSegment(-0.03150856497373, 0.0382179805409, 0)
298    
299     swModel.Extension.SelectByID2("", "SKETCHSEGMENT", skfin.X, skfin.Y, skfin.Z, False, 0, Nothing, 0)
300     swModel.EditDelete()
301     swModel.InsertSketch()
302     swModel.EditRebuild3()
303    
304     Dim feat As sldworks.Feature = swModel.FeatureByPositionReverse(0)
305     If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
306     PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
307     Me.GénérerSweep(PetitSketch)
308    
309    
310     ' b- répétition par courbe
311     segment.Select2(False, 1)
312     Me.BodySweep.Select(True, 256)
313    
314     swModel.FeatureCurvePattern(nb, longueur / nb, 1, 0.05, False, False, False, False, True, True, False, False)
315    
316    
317     ' on sélectionne le body et ceux des répétitions by curve
318     feat = swModel.FeatureByPositionReverse(0)
319     feat.Select2(False, 0)
320    
321     ' Dim selMgr As sldworks.SelectionMgr = swModel.SelectionManager
322     ' MsgBox(selMgr.GetSelectedObjectCount2(-1) & selMgr.GetSelectedObjectType3(1, -1))
323    
324     Dim vBodies As Object = swPart.GetBodies2(swconst.swBodyType_e.swSolidBody, True)
325     swModel.ClearSelection2(True)
326     Me.SelectionneBonneCoque(True, 16)
327     swEnt = Me.sFaceVolume.SwFace : swEnt.Select2(True, 32)
328     For j As Integer = (UBound(vBodies) - nb + 1) To UBound(vBodies)
329     Dim swBody As sldworks.Body2 = vBodies(j)
330     Dim swface As sldworks.Face2 = swBody.GetFirstFace()
331    
332    
333     While swface IsNot Nothing
334     swEnt = swface : swEnt.Select2(True, 16)
335     swface = swface.GetNextFace()
336     End While
337     Next j
338     feat = featmanager.InsertSplitLineIntersect(7)
339    
340    
341     ' il faut aussi couper la coque
342     swEnt = Me.sFaceCoque.SwFace : swEnt.Select2(False, 32)
343     For j As Integer = (UBound(vBodies) - nb) To UBound(vBodies)
344     Dim swBody As sldworks.Body2 = vBodies(j)
345     Dim swface As sldworks.Face2 = swBody.GetFirstFace()
346    
347     MsgBox(swBody.Name)
348     While swface IsNot Nothing
349     swEnt = swface : swEnt.Select2(True, 16)
350     swface = swface.GetNextFace()
351     End While
352     Next j
353     feat = featmanager.InsertSplitLineIntersect(7)
354     Next segment
355    
356    
357    
358     ' 4 - flagger les arêtes
359     End Sub
360    
361 bournival 40 ''' <summary>
362     ''' Sub qui prend les infos de la classe (qui a un sweep) et qui découpe la face du VOLUME. Met les attributs de face interne également.
363     ''' </summary>
364     ''' <remarks>Utile pour les intersections coque-volume seulement (pour l'instant)</remarks>
365     Public Sub DécouperVolume()
366 bournival 130 'Algo: On créé un sweep. puis on découpe la face du volume selon le sweep et la coque elle-même
367 bournival 40
368 bournival 130 If Intersections.MultiDecoupageCoques Then
369     ' on doit mettre faire plusieurs découpages de coques.
370     multidecoupage()
371     Else
372     Dim vseg As Object = Me.sketch.GetSketchSegments
373     Dim PetitSketch As sldworks.Sketch = Nothing
374     Dim swSketchManager As sldworks.SketchManager = swModel.SketchManager
375     Dim sfaceVol As SlyFaceVolume ' la face du volume
376     Dim swfaceVol As sldworks.Face2
377 bournival 40
378 bournival 130 For Each segment As sldworks.SketchSegment In vseg
379     swModel.ClearSelection()
380     If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
381     swModel.Insert3DSketch2(False)
382     segment.Select4(False, Nothing)
383     swSketchManager.SketchUseEdge(False)
384     swModel.Insert3DSketch2(False)
385     swModel.EditRebuild3()
386 bournival 40
387 bournival 130 Dim feat As sldworks.Feature = swModel.FeatureByPositionReverse(0)
388     If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
389     PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
390 bournival 40
391 bournival 130 ' 1 - créer le sweep à partir du sketch
392     Me.GénérerSweep(PetitSketch) ' hahahaha on réutilise la sub !!
393 bournival 40
394 bournival 130 ' sélectionner toutes les faces du sweep avec un mark de 16
395     Dim swFaceSweep As sldworks.Face2 = Me.BodySweep.GetFirstFace()
396     Dim swent As sldworks.Entity
397     Dim featmanager As sldworks.FeatureManager
398     Dim faces() As sldworks.Face2
399 bournival 40
400    
401 bournival 130 ' ***** Découpage du volume****
402     swModel.EditRebuild3()
403     featmanager = swModel.FeatureManager
404     feat = Nothing
405     sfaceVol = Me.sFaceVolume
406     faces = sfaceVol.GetFaces
407     Dim scoque As SlyFaceCoque = Me.sFaceCoque
408 bournival 40
409 bournival 130 For q As Integer = 0 To UBound(faces)
410     swfaceVol = faces(q)
411     ' merde, on a 3 fois la même face??? vérifier que le for each marche bien et/ou que le .ToArray du faces est corect.
412     If swModel.ClosestDistance(swfaceVol, Me.BodySweep, Nothing, Nothing) < Epsilon Then
413 bournival 40
414 bournival 130 swModel.ClearSelection2(True)
415     Do While swFaceSweep IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
416     swent = swFaceSweep : swent.Select2(True, 16)
417     swFaceSweep = swFaceSweep.GetNextFace
418     Loop
419 bournival 40
420 bournival 130 ' sélection de la bonne face de coque:
421     'swent = swfaceCoque : swent.Select2(True, 16)
422     Me.SelectionneBonneCoque(True, 16)
423     swent = swfaceVol : swent.Select2(True, 32)
424     feat = featmanager.InsertSplitLineIntersect(7)
425     If feat IsNot Nothing Then Exit For
426 bournival 40
427 bournival 130 End If
428     Next
429 bournival 40
430 bournival 130 If feat Is Nothing Then
431     If swApp.SendMsgToUser2("Solidworks est incapable de découper la face du volume, entre " & Me.sFaceCoque.nom & " et " & Me.sFaceVolume.nom & vbCr & " La géométrie est trop compliquée pour solidworks!", swconst.swMessageBoxIcon_e.swMbWarning, swconst.swMessageBoxBtn_e.swMbRetryCancel) = swconst.swMessageBoxResult_e.swMbHitCancel Then Exit Sub
432     End If
433 bournival 40
434 bournival 130 Me.BodySweep.HideBody(True)
435 bournival 40
436 bournival 130 ' ajout des nouvelles faces
437     Dim vfaces As Object = feat.GetFaces()
438     swModel.EditRebuild3()
439 bournival 40
440 bournival 130 For Each swfaceVol In vfaces ' sélectionne les faces découpées.
441     If Not swfaceVol.GetBody Is Me.BodySweep Then
442     sfaceVol.AjouterFace(swfaceVol)
443     'là on a une conneraie, la face originale n'est pas dans la liste des faces de vFaces
444     'et le pointeur original semble détruit
445     ' puisque ajouterface ne créé pas de doubles, on va chercher des faces que l'on mettra dans la liste
446     ' la grosse face en fera automatiquement partie.
447     Dim obj As Object = swfaceVol.GetEdges
448     For iface As Integer = 0 To UBound(obj)
449     Dim aretes As sldworks.Edge = obj(iface)
450     Dim oBjfaces As Object = aretes.GetTwoAdjacentFaces2()
451     Dim NewFaces As sldworks.Face2 = oBjfaces(0)
452     sfaceVol.AjouterFace(NewFaces)
453     NewFaces = oBjfaces(1)
454     sfaceVol.AjouterFace(NewFaces)
455     Next
456     'aretes = obj(1)
457     'NewFaces = oBjfaces(0)
458     'sfaceVol.AjouterFace(NewFaces)
459     'NewFaces = oBjfaces(1)
460     'sfaceVol.AjouterFace(NewFaces)
461     End If
462     Next
463     Next
464     End If
465 bournival 40 End Sub
466    
467     ''' <summary>
468     ''' S'il y a plus d'une face dans la coque, cette sub sélectionne la bonne face (celle qui touche au sweep)
469     ''' </summary>
470     ''' <param name="Append"></param>
471     ''' <param name="Mark"></param>
472     ''' <remarks></remarks>
473     Private Sub SelectionneBonneCoque(ByRef Append As Boolean, ByRef Mark As Integer)
474     Dim swEnt As SldWorks.Entity
475     Dim vfaces() As SldWorks.Face2 = Me.sFaceCoque.GetFaces
476    
477     If UBound(vfaces) = 0 Then swEnt = vfaces(0) : swEnt.Select2(Append, Mark) : Exit Sub
478    
479     ' bon, on a plusieurs faces pour représenter la coque, il faut trouver celle qui est à l'intérieur du sweep
480     ' celles dont une arête ne touche pas au sweep est Out.
481     ' possible qu'il y ait un cas fucké où ça ne marche pas.
482     For Each swFace As SldWorks.Face2 In vfaces
483     Dim vedges As Object = swFace.GetEdges
484     Dim prendre As Boolean = True
485    
486     For Each swArete As SldWorks.Edge In vedges
487 bournival 130 If swModel.ClosestDistance(Me.BodySweep, swArete, Nothing, Nothing) > 1000 * Epsilon Then prendre = False : Continue For
488 bournival 40 Next
489    
490     If prendre Then swEnt = swFace : swEnt.Select2(Append, Mark) : Exit Sub
491     Next
492    
493    
494     MsgBox("Rien trouvé!!!")
495    
496     End Sub
497    
498     ''' <summary>
499     ''' Sub qui prend les infos de la classe (qui a un sweep) et qui découpe la face du VOLUME. Met les attributs de face interne également.
500     ''' </summary>
501     ''' <remarks>Utile pour les intersections coque-volume seulement (pour l'instant)</remarks>
502     Public Sub DecouperCoque()
503 bournival 130 'If Me.BodySweep Is Nothing Then Exit Sub
504 bournival 40
505     DerniereCoupe = False ' pas besoin de redecouper
506     ' on a un sketch avec 2 ou plusieurs segments à l'intérieur
507     ' et si je sélectionnais un segment à la fois et partait un sketch3d, puis je convertis ce segment et construit ce nouveau sketch...
508     Dim vseg As Object = Me.sketch.GetSketchSegments
509     Dim PetitSketch As SldWorks.Sketch = Nothing
510     Dim swSketchManager As SldWorks.SketchManager = swModel.SketchManager
511 bournival 130
512     Dim swFace As sldworks.Face2 ' = Me.BodySweep.GetFirstFace()
513 bournival 40 Dim swent As SldWorks.Entity
514     Dim featmanager As SldWorks.FeatureManager
515     Dim swface2 As SldWorks.Face2
516     Dim scoque As SlyFaceCoque = Me.sFaceCoque
517    
518    
519     For Each segment As SldWorks.SketchSegment In vseg
520     swModel.ClearSelection()
521     If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
522     swModel.Insert3DSketch2(False)
523     segment.Select4(False, Nothing)
524     swSketchManager.SketchUseEdge(False)
525     swModel.Insert3DSketch2(False)
526     swModel.EditRebuild3()
527    
528     Dim feat As SldWorks.Feature = swModel.FeatureByPositionReverse(0)
529     If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
530     PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
531    
532     ' 1 - créer le sweep à partir du sketch
533     Me.GénérerSweep(PetitSketch) ' hahahaha on réutilise la sub !!
534    
535 bournival 130 ' 2 - Couper la coque à partir du sweep
536 bournival 40 swModel.EditRebuild3()
537     featmanager = swModel.FeatureManager
538     Dim faces() As SldWorks.Face2 = scoque.GetFaces
539     For Each swface2 In faces ' les faces de la coque
540     If swModel.ClosestDistance(swface2, Me.BodySweep, Nothing, Nothing) < Epsilon Then
541     swModel.ClearSelection2(True)
542     swFace = Me.BodySweep.GetFirstFace()
543     Do While swFace IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
544     swent = swFace : swent.Select2(True, 16)
545     swFace = swFace.GetNextFace
546     Loop
547     swent = swface2 : swent.Select2(True, 32) ' la face qui est coupée
548     feat = featmanager.InsertSplitLineIntersect(7)
549     'If feat IsNot Nothing Then lstFeat.Add(feat)
550     End If
551     Next
552     Me.BodySweep.HideBody(True)
553    
554     ' rajout des nouvelles faces à la coque
555     feat = swModel.FeatureByPositionReverse(0)
556     Dim vFaces As Object = feat.GetFaces()
557     For Each swFace In vFaces
558     Me.sFaceCoque.AjouterFace(swFace)
559     Next
560    
561     Next
562    
563    
564    
565    
566     End Sub
567    
568    
569     ''' <summary>
570 bournival 130 '''
571 bournival 40 ''' </summary>
572     ''' <returns>Vrai si la coque doit être coupée</returns>
573 bournival 130 ''' <remarks>Doit avoir trouvé l'arèteCoue avant</remarks>
574     Public ReadOnly Property DoitCouperCoque() As Boolean
575     Get
576     Dim vSeg As Object = Me.sketch.GetSketchSegments()
577     If vSeg Is Nothing Then Return False ' dans le cas d'une face de section, on aurait pas de sketch?
578     If UBound(vSeg) > 0 Then
579     Return True
580     Else ' si on ne trouve pas l'arète alors on doit couper
581     If Me.QuelleAreteCoqueToucheVolume Is Nothing Then Return True
582     End If
583     Return False
584     End Get
585 bournival 40
586 bournival 130 End Property
587 bournival 40
588 bournival 130
589    
590    
591 bournival 40 ''' <summary>
592     ''' Sub qui met les attributs de faces internes sur les bonnes faces.
593     ''' </summary>
594     ''' <remarks></remarks>
595     Public Sub MarquerFacesInternes()
596     ' bon, là il faut trouver les faces internes... mais: la liste de faces dans la slyface
597     'mais j'ai maintenant un moyen de comparer les arètes.
598     Dim trouve As Boolean = False
599 bournival 130 Dim effacer As Boolean = False
600 bournival 40 ' si une face de la liste des facesVol a une arête qui est comparer à true à une des arètes des faces de la coque, FACEINTERNE!!!
601 bournival 50 Dim swFaces() As sldworks.Face2 = Me.sFaceVolume.GetFaces
602     Dim swAreteCoques() As sldworks.Edge = Me.sFaceCoque.GetAretes
603 bournival 40
604 bournival 130 second_essai:
605 bournival 50 For Each face As sldworks.Face2 In swFaces
606 bournival 40 Dim sFace As New SuperFace(face, True)
607 bournival 50 Dim swAreteVols() As sldworks.Edge = sFace.GetAretes
608     For Each swAreteVol As sldworks.Edge In swAreteVols
609 bournival 130 Dim e As New SuperArete(swAreteVol, True) ': e.Colorer(2, 0, 1, 0)
610 bournival 50 For Each swAreteCoque As sldworks.Edge In swAreteCoques
611 bournival 130 Dim e2 As New SuperArete(swAreteCoque, True) ': e2.Colorer(2, 1, 0, 0)
612     Try
613     If effacer Then e.Colorer(5, 0, 1, 0)
614     Debug.Print(e.Rayon)
615     If e.comparer(e2) Then
616     e.Colorer(4, 0.5, 0.5, 0)
617     e2.Colorer(2, 0.5, 0.5, 0)
618     If Me.FaceDeSection Then TrouverEpaisseur(face)
619     'sFace.MettreAttributFaceInterne(sFace.SwFace, Me.sFaceCoque.GetEpaisseur / 4.2, False)
620    
621     ' *** modif Juin 2008 ****
622     Dim swface1, swFace2 As sldworks.Face2
623     e.PasserLes2FacesAdjascentes(swface1, swFace2)
624     Dim f1 As New SuperFace(swface1, True) : Dim f2 As New SuperFace(swFace2, True)
625     f1.MettreAttributFaceInterne(f1.SwFace, Me.sFaceCoque.GetEpaisseur / 4.2, False)
626     f2.MettreAttributFaceInterne(f2.SwFace, Me.sFaceCoque.GetEpaisseur / 4.2, False)
627     ' *** fin modifs
628    
629     trouve = True ': Exit For ' tention, peut y'en avoir plus qu'une.
630     End If
631     Catch
632     MsgBox("Bug ici, ")
633     End Try
634    
635 bournival 40 Next
636 bournival 130
637 bournival 40 Next
638     Next
639    
640 bournival 130
641    
642     ' ça ne devrait pas arriver souvent, mais dans certains cas d'exception, la face n'est pas trouvée...
643     If Not trouve Then
644     MsgBox("Face interne non trouvée... Un algorithme plus long doit être employé :-(") : effacer = True
645    
646     Dim lstfaces As New Collections.Generic.List(Of sldworks.Face2)
647     Dim vBodies As Object = swPart.GetBodies2(swconst.swBodyType_e.swSolidBody, True)
648     If Not vBodies Is Nothing Then
649     For v As Integer = 0 To UBound(vBodies)
650     Dim swBody As sldworks.Body2 = vBodies(v)
651     Dim swFace As sldworks.Face2 = swBody.GetFirstFace
652     Do While Not swFace Is Nothing
653     lstfaces.Add(swFace)
654     swFace = swFace.GetNextFace()
655     Loop
656     Next
657     End If
658     swFaces = lstfaces.ToArray
659     GoTo second_essai
660     End If
661    
662    
663    
664    
665 bournival 40 End Sub
666    
667 bournival 130 ''' <summary>
668     ''' Dans le cas d'une coque «Face_de_section», cette sub trouve automatiquement l'épaisseur de la coque
669     ''' </summary>
670     ''' <remarks></remarks>
671     Private Sub TrouverEpaisseur(ByRef swFace As sldworks.Face2)
672 bournival 40
673 bournival 130 Dim swAretes As New Collections.Generic.List(Of sldworks.Edge)
674    
675     Dim obj As Object = swface.GetEdges
676     For iface As Integer = 0 To UBound(obj)
677     swAretes.Add(obj(iface))
678     Next iface
679    
680     Dim longueur As Double
681     Dim epaiss As Double = 99999999
682    
683     ' Si on a une section carrée
684     If swAretes.Count = 4 Then
685     For Each swArete As sldworks.Edge In swAretes
686     Dim a As New SuperArete(swArete, True)
687     longueur = a.Longueur
688     If longueur < epaiss Then epaiss = longueur
689     Next
690    
691     ElseIf swAretes.Count = 2 Then
692     ' si on a une section circulaire
693     Dim a1 As New SuperArete(swAretes(0), True)
694     Dim a2 As New SuperArete(swAretes(1), True)
695    
696     If a1.IsCircle Then
697     epaiss = Math.Abs(a1.Rayon - a2.Rayon)
698     Else
699     MsgBox("Courbe fermée, mais pas un cercle, le code pour trouver automatiquement l'épaisseur de cette coque n'est pas encore programmé" & vbCr & "Ceci n'affecte que très peu la carte de taille, alors rien de grave! ")
700     End If
701    
702     Else
703     MsgBox("Il y a un problème dans la détermination automatique de l'épaisseur d'une coque." & vbCr & "La coque a une face_de_section, mais n'est pas composée de 2 ou 4 arètes..." & vbCr & "Ceci n'affecte que très peu la carte de taille, alors rien de grave! ", MsgBoxStyle.OkOnly + MsgBoxStyle.MsgBoxSetForeground + MsgBoxStyle.Exclamation, "Warning")
704     End If
705    
706     Me.sFaceCoque.GetEpaisseur = epaiss * 2
707     End Sub
708    
709    
710     ''' <summary>
711     ''' Retourne vrai si l'intersection est de type face_A_plat. i.e. si la coque repose sur une petite face du volume
712     ''' </summary>
713     ''' <returns></returns>
714     ''' <remarks></remarks>
715     Public Function Face_A_Plat() As Boolean
716     ' Brainstorm:
717     ' si la normale de la face à n'importequel de ses sommets est la même que la coque à ce sommet alors
718     ' on a une face_a_plat, même si le sommet n'appartient pas aux 2 faces!!!
719    
720     ' Brainstorm 2: On analyse les 2 surfaces...
721     Dim swSurf1 As sldworks.Surface = Me.sFaceCoque.GetSurface
722     Dim swSurf2 As sldworks.Surface = Me.sFaceVolume.GetSurface
723    
724     If ComparerSurfaces(swSurf1, swSurf2) Then Return True Else Return False
725    
726     ''mais si on a 2 cercles ou ellipses....
727     'Dim x, y, z As Double
728    
729     'Dim eSommet As New SuperSommet(swSommet, True)
730     'Dim normaleVol() As Double = Me.sFaceVolume.GetNormale(eSommet.GetX, eSommet.GetY, eSommet.GetZ)
731     'Dim normaleCoque() As Double = Me.sFaceCoque.GetNormale(x, y, z)
732    
733     'Dim angle As Double = Outils_Math.Angle2Vecteurs(normaleVol, normaleCoque) < 0.00001
734     'If angle < 0.00001 Or Math.Abs(angle - Math.PI) < 0.00001 Then
735     ' Return True
736     'Else : Return False
737     'End If
738    
739     End Function
740    
741    
742     ''' <summary>
743     ''' Active l'algorithme de découpage de face-à-plat
744     ''' </summary>
745     ''' <remarks></remarks>
746     Public Sub DécouperFace_A_Plat()
747     MsgBox("On doit découper une face à plat")
748    
749    
750    
751     End Sub
752    
753    
754    
755 bournival 40 End Class