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

File Contents

# User Rev Content
1 bournival 48 Imports SolidWorks.Interop
2     Imports SolidWorks.Interop.swconst
3     Imports SolidWorks.Interop.swpublished
4    
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 bournival 205 feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, swTangencyType_e.swTangencyNone, swTangencyType_e.swTangencyNone, False, 0, 0, 0, 0, 0, 1, 1, 0, 1)
215 bournival 40
216     If feat Is Nothing Then
217     swEnt = sketchCercle : swEnt.Select2(False, 1)
218     swEnt = sketch : swEnt.Select2(True, 4)
219 bournival 205 feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, swTangencyType_e.swTangencyNone, swTangencyType_e.swTangencyNone, False, 0, 0, 0, 0, 0, 1, 1, 0, 1)
220 bournival 40 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 bournival 205 Dim swface As sldworks.Face2 = vfaces(0)
231 bournival 40 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 bournival 205 'faces = sfaceVol.GetFaces
407 bournival 130 Dim scoque As SlyFaceCoque = Me.sFaceCoque
408 bournival 40
409 bournival 205 '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 205 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 205 ' sélection de la bonne face de coque:
421     'Me.SelectionneBonneCoque(True, 16)
422     Me.sFaceCoque.SelectionnerToutes(16, True)
423 bournival 40
424 bournival 205 ' sélection de tout le volume
425     Dim swBod As sldworks.Body2 = Me.sFaceVolume.SwFace.GetBody : swBod.Select(True, 32)
426     'swent = swfaceVol : swent.Select2(True, 32)
427 bournival 40
428 bournival 205 feat = featmanager.InsertSplitLineIntersect(7)
429     'If feat IsNot Nothing Then Exit For
430    
431     ' End If
432     'Next
433    
434 bournival 130 If feat Is Nothing Then
435     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
436     End If
437 bournival 40
438 bournival 130 Me.BodySweep.HideBody(True)
439 bournival 40
440 bournival 130 ' ajout des nouvelles faces
441     Dim vfaces As Object = feat.GetFaces()
442     swModel.EditRebuild3()
443 bournival 40
444 bournival 130 For Each swfaceVol In vfaces ' sélectionne les faces découpées.
445     If Not swfaceVol.GetBody Is Me.BodySweep Then
446 bournival 205 If swfaceVol Is Nothing Then Exit For
447 bournival 130 sfaceVol.AjouterFace(swfaceVol)
448 bournival 205 'là on a une connerie, la face originale n'est pas dans la liste des faces de vFaces
449 bournival 130 'et le pointeur original semble détruit
450     ' puisque ajouterface ne créé pas de doubles, on va chercher des faces que l'on mettra dans la liste
451     ' la grosse face en fera automatiquement partie.
452     Dim obj As Object = swfaceVol.GetEdges
453     For iface As Integer = 0 To UBound(obj)
454     Dim aretes As sldworks.Edge = obj(iface)
455     Dim oBjfaces As Object = aretes.GetTwoAdjacentFaces2()
456     Dim NewFaces As sldworks.Face2 = oBjfaces(0)
457     sfaceVol.AjouterFace(NewFaces)
458     NewFaces = oBjfaces(1)
459     sfaceVol.AjouterFace(NewFaces)
460     Next
461     'aretes = obj(1)
462     'NewFaces = oBjfaces(0)
463     'sfaceVol.AjouterFace(NewFaces)
464     'NewFaces = oBjfaces(1)
465     'sfaceVol.AjouterFace(NewFaces)
466     End If
467     Next
468     Next
469     End If
470 bournival 40 End Sub
471    
472     ''' <summary>
473     ''' S'il y a plus d'une face dans la coque, cette sub sélectionne la bonne face (celle qui touche au sweep)
474     ''' </summary>
475     ''' <param name="Append"></param>
476     ''' <param name="Mark"></param>
477     ''' <remarks></remarks>
478     Private Sub SelectionneBonneCoque(ByRef Append As Boolean, ByRef Mark As Integer)
479     Dim swEnt As SldWorks.Entity
480     Dim vfaces() As SldWorks.Face2 = Me.sFaceCoque.GetFaces
481    
482     If UBound(vfaces) = 0 Then swEnt = vfaces(0) : swEnt.Select2(Append, Mark) : Exit Sub
483    
484     ' bon, on a plusieurs faces pour représenter la coque, il faut trouver celle qui est à l'intérieur du sweep
485     ' celles dont une arête ne touche pas au sweep est Out.
486     ' possible qu'il y ait un cas fucké où ça ne marche pas.
487     For Each swFace As SldWorks.Face2 In vfaces
488     Dim vedges As Object = swFace.GetEdges
489     Dim prendre As Boolean = True
490    
491     For Each swArete As SldWorks.Edge In vedges
492 bournival 130 If swModel.ClosestDistance(Me.BodySweep, swArete, Nothing, Nothing) > 1000 * Epsilon Then prendre = False : Continue For
493 bournival 40 Next
494    
495     If prendre Then swEnt = swFace : swEnt.Select2(Append, Mark) : Exit Sub
496     Next
497    
498    
499     MsgBox("Rien trouvé!!!")
500    
501     End Sub
502    
503     ''' <summary>
504     ''' 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.
505     ''' </summary>
506     ''' <remarks>Utile pour les intersections coque-volume seulement (pour l'instant)</remarks>
507     Public Sub DecouperCoque()
508 bournival 130 'If Me.BodySweep Is Nothing Then Exit Sub
509 bournival 40
510     DerniereCoupe = False ' pas besoin de redecouper
511     ' on a un sketch avec 2 ou plusieurs segments à l'intérieur
512     ' et si je sélectionnais un segment à la fois et partait un sketch3d, puis je convertis ce segment et construit ce nouveau sketch...
513     Dim vseg As Object = Me.sketch.GetSketchSegments
514     Dim PetitSketch As SldWorks.Sketch = Nothing
515     Dim swSketchManager As SldWorks.SketchManager = swModel.SketchManager
516 bournival 130
517     Dim swFace As sldworks.Face2 ' = Me.BodySweep.GetFirstFace()
518 bournival 40 Dim swent As SldWorks.Entity
519     Dim featmanager As SldWorks.FeatureManager
520     Dim swface2 As SldWorks.Face2
521     Dim scoque As SlyFaceCoque = Me.sFaceCoque
522    
523    
524     For Each segment As SldWorks.SketchSegment In vseg
525     swModel.ClearSelection()
526     If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
527     swModel.Insert3DSketch2(False)
528     segment.Select4(False, Nothing)
529     swSketchManager.SketchUseEdge(False)
530     swModel.Insert3DSketch2(False)
531     swModel.EditRebuild3()
532    
533     Dim feat As SldWorks.Feature = swModel.FeatureByPositionReverse(0)
534     If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
535     PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
536    
537     ' 1 - créer le sweep à partir du sketch
538     Me.GénérerSweep(PetitSketch) ' hahahaha on réutilise la sub !!
539    
540 bournival 130 ' 2 - Couper la coque à partir du sweep
541 bournival 40 swModel.EditRebuild3()
542     featmanager = swModel.FeatureManager
543     Dim faces() As SldWorks.Face2 = scoque.GetFaces
544     For Each swface2 In faces ' les faces de la coque
545     If swModel.ClosestDistance(swface2, Me.BodySweep, Nothing, Nothing) < Epsilon Then
546     swModel.ClearSelection2(True)
547     swFace = Me.BodySweep.GetFirstFace()
548     Do While swFace IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
549     swent = swFace : swent.Select2(True, 16)
550     swFace = swFace.GetNextFace
551     Loop
552     swent = swface2 : swent.Select2(True, 32) ' la face qui est coupée
553     feat = featmanager.InsertSplitLineIntersect(7)
554     'If feat IsNot Nothing Then lstFeat.Add(feat)
555     End If
556     Next
557     Me.BodySweep.HideBody(True)
558    
559     ' rajout des nouvelles faces à la coque
560     feat = swModel.FeatureByPositionReverse(0)
561     Dim vFaces As Object = feat.GetFaces()
562     For Each swFace In vFaces
563     Me.sFaceCoque.AjouterFace(swFace)
564     Next
565    
566     Next
567    
568    
569    
570    
571     End Sub
572    
573    
574     ''' <summary>
575 bournival 130 '''
576 bournival 40 ''' </summary>
577     ''' <returns>Vrai si la coque doit être coupée</returns>
578 bournival 130 ''' <remarks>Doit avoir trouvé l'arèteCoue avant</remarks>
579     Public ReadOnly Property DoitCouperCoque() As Boolean
580     Get
581     Dim vSeg As Object = Me.sketch.GetSketchSegments()
582     If vSeg Is Nothing Then Return False ' dans le cas d'une face de section, on aurait pas de sketch?
583     If UBound(vSeg) > 0 Then
584     Return True
585     Else ' si on ne trouve pas l'arète alors on doit couper
586     If Me.QuelleAreteCoqueToucheVolume Is Nothing Then Return True
587     End If
588     Return False
589     End Get
590 bournival 40
591 bournival 130 End Property
592 bournival 40
593 bournival 130
594    
595    
596 bournival 40 ''' <summary>
597     ''' Sub qui met les attributs de faces internes sur les bonnes faces.
598     ''' </summary>
599     ''' <remarks></remarks>
600     Public Sub MarquerFacesInternes()
601     ' bon, là il faut trouver les faces internes... mais: la liste de faces dans la slyface
602     'mais j'ai maintenant un moyen de comparer les arètes.
603     Dim trouve As Boolean = False
604 bournival 130 Dim effacer As Boolean = False
605 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!!!
606 bournival 50 Dim swFaces() As sldworks.Face2 = Me.sFaceVolume.GetFaces
607     Dim swAreteCoques() As sldworks.Edge = Me.sFaceCoque.GetAretes
608 bournival 40
609 bournival 130 second_essai:
610 bournival 50 For Each face As sldworks.Face2 In swFaces
611 bournival 40 Dim sFace As New SuperFace(face, True)
612 bournival 50 Dim swAreteVols() As sldworks.Edge = sFace.GetAretes
613     For Each swAreteVol As sldworks.Edge In swAreteVols
614 bournival 130 Dim e As New SuperArete(swAreteVol, True) ': e.Colorer(2, 0, 1, 0)
615 bournival 50 For Each swAreteCoque As sldworks.Edge In swAreteCoques
616 bournival 130 Dim e2 As New SuperArete(swAreteCoque, True) ': e2.Colorer(2, 1, 0, 0)
617     Try
618     If effacer Then e.Colorer(5, 0, 1, 0)
619     Debug.Print(e.Rayon)
620     If e.comparer(e2) Then
621     e.Colorer(4, 0.5, 0.5, 0)
622     e2.Colorer(2, 0.5, 0.5, 0)
623     If Me.FaceDeSection Then TrouverEpaisseur(face)
624     'sFace.MettreAttributFaceInterne(sFace.SwFace, Me.sFaceCoque.GetEpaisseur / 4.2, False)
625    
626     ' *** modif Juin 2008 ****
627     Dim swface1, swFace2 As sldworks.Face2
628     e.PasserLes2FacesAdjascentes(swface1, swFace2)
629     Dim f1 As New SuperFace(swface1, True) : Dim f2 As New SuperFace(swFace2, True)
630     f1.MettreAttributFaceInterne(f1.SwFace, Me.sFaceCoque.GetEpaisseur / 4.2, False)
631     f2.MettreAttributFaceInterne(f2.SwFace, Me.sFaceCoque.GetEpaisseur / 4.2, False)
632     ' *** fin modifs
633    
634     trouve = True ': Exit For ' tention, peut y'en avoir plus qu'une.
635     End If
636     Catch
637     MsgBox("Bug ici, ")
638     End Try
639    
640 bournival 40 Next
641 bournival 130
642 bournival 40 Next
643     Next
644    
645 bournival 130
646    
647     ' ça ne devrait pas arriver souvent, mais dans certains cas d'exception, la face n'est pas trouvée...
648     If Not trouve Then
649     MsgBox("Face interne non trouvée... Un algorithme plus long doit être employé :-(") : effacer = True
650    
651     Dim lstfaces As New Collections.Generic.List(Of sldworks.Face2)
652     Dim vBodies As Object = swPart.GetBodies2(swconst.swBodyType_e.swSolidBody, True)
653     If Not vBodies Is Nothing Then
654     For v As Integer = 0 To UBound(vBodies)
655     Dim swBody As sldworks.Body2 = vBodies(v)
656     Dim swFace As sldworks.Face2 = swBody.GetFirstFace
657     Do While Not swFace Is Nothing
658     lstfaces.Add(swFace)
659     swFace = swFace.GetNextFace()
660     Loop
661     Next
662     End If
663     swFaces = lstfaces.ToArray
664 bournival 205 'GoTo second_essai
665 bournival 130 End If
666    
667    
668    
669    
670 bournival 40 End Sub
671    
672 bournival 130 ''' <summary>
673     ''' Dans le cas d'une coque «Face_de_section», cette sub trouve automatiquement l'épaisseur de la coque
674     ''' </summary>
675     ''' <remarks></remarks>
676     Private Sub TrouverEpaisseur(ByRef swFace As sldworks.Face2)
677 bournival 40
678 bournival 130 Dim swAretes As New Collections.Generic.List(Of sldworks.Edge)
679    
680     Dim obj As Object = swface.GetEdges
681     For iface As Integer = 0 To UBound(obj)
682     swAretes.Add(obj(iface))
683     Next iface
684    
685     Dim longueur As Double
686     Dim epaiss As Double = 99999999
687    
688     ' Si on a une section carrée
689     If swAretes.Count = 4 Then
690     For Each swArete As sldworks.Edge In swAretes
691     Dim a As New SuperArete(swArete, True)
692     longueur = a.Longueur
693     If longueur < epaiss Then epaiss = longueur
694     Next
695    
696     ElseIf swAretes.Count = 2 Then
697     ' si on a une section circulaire
698     Dim a1 As New SuperArete(swAretes(0), True)
699     Dim a2 As New SuperArete(swAretes(1), True)
700    
701     If a1.IsCircle Then
702     epaiss = Math.Abs(a1.Rayon - a2.Rayon)
703     Else
704     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! ")
705     End If
706    
707     Else
708     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")
709     End If
710    
711     Me.sFaceCoque.GetEpaisseur = epaiss * 2
712     End Sub
713    
714    
715     ''' <summary>
716     ''' Retourne vrai si l'intersection est de type face_A_plat. i.e. si la coque repose sur une petite face du volume
717     ''' </summary>
718     ''' <returns></returns>
719     ''' <remarks></remarks>
720     Public Function Face_A_Plat() As Boolean
721     ' Brainstorm:
722     ' si la normale de la face à n'importequel de ses sommets est la même que la coque à ce sommet alors
723     ' on a une face_a_plat, même si le sommet n'appartient pas aux 2 faces!!!
724    
725     ' Brainstorm 2: On analyse les 2 surfaces...
726     Dim swSurf1 As sldworks.Surface = Me.sFaceCoque.GetSurface
727     Dim swSurf2 As sldworks.Surface = Me.sFaceVolume.GetSurface
728    
729     If ComparerSurfaces(swSurf1, swSurf2) Then Return True Else Return False
730    
731     ''mais si on a 2 cercles ou ellipses....
732     'Dim x, y, z As Double
733    
734     'Dim eSommet As New SuperSommet(swSommet, True)
735     'Dim normaleVol() As Double = Me.sFaceVolume.GetNormale(eSommet.GetX, eSommet.GetY, eSommet.GetZ)
736     'Dim normaleCoque() As Double = Me.sFaceCoque.GetNormale(x, y, z)
737    
738     'Dim angle As Double = Outils_Math.Angle2Vecteurs(normaleVol, normaleCoque) < 0.00001
739     'If angle < 0.00001 Or Math.Abs(angle - Math.PI) < 0.00001 Then
740     ' Return True
741     'Else : Return False
742     'End If
743    
744     End Function
745    
746    
747     ''' <summary>
748     ''' Active l'algorithme de découpage de face-à-plat
749     ''' </summary>
750     ''' <remarks></remarks>
751     Public Sub DécouperFace_A_Plat()
752     MsgBox("On doit découper une face à plat")
753    
754    
755    
756     End Sub
757    
758    
759    
760 bournival 40 End Class