ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterCoqueVolume.vb
Revision: 50
Committed: Fri Aug 24 21:19:38 2007 UTC (17 years, 8 months ago) by bournival
File size: 18495 byte(s)
Log Message:
Le slider marche maintenant

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     Public DerniereCoupe As Boolean = False
21    
22     ''' <summary>
23     ''' Quand on a une intersection coque-volume avec face de section, il faut trouver quelle arète de la coque touche au volume
24     ''' </summary>
25     ''' <param name="GuideSweep">Si oui alors on utilise le sweep pour se guider, utile dans le cas #1</param>
26     ''' <remarks></remarks>
27     Public Sub QuelleAreteCoqueToucheVolume(Optional ByVal GuideSweep As Boolean = False)
28     Dim aretes() As SldWorks.Edge
29     Dim Sommet1 As SldWorks.Vertex
30     Dim sommet2 As SldWorks.Vertex
31     Dim z As Integer
32    
33    
34     'Dim swFace() As SldWorks.Face2 = sFaceCoque.DonnerFaces ' attention, pas juste une face.....
35     aretes = sFaceCoque.GetAretes()
36     Dim swFaceVol() As SldWorks.Face2 = Me.sFaceVolume.GetFaces
37    
38    
39     For Each swFaceV As SldWorks.Face2 In swFaceVol
40     For z = 0 To UBound(aretes)
41     Sommet1 = aretes(z).GetStartVertex()
42     If Sommet1 Is Nothing Then ' on a un cercle...
43     Dim params As Object
44     params = aretes(z).Evaluate(0.5) ' 0.5 pour ne pas être à 0, ni 1, ni 3.14. Pour être très méticuleur il faudrait vérifier 2 points...
45     If Distance(swFaceV, params(0), params(1), params(2)) < Epsilon Then AreteCoque = aretes(z) : Exit Sub
46     Else
47     sommet2 = aretes(z).GetEndVertex()
48     If Commun.Distance(swFaceV, Sommet1) < Epsilon AndAlso Distance(swFaceV, sommet2) < Epsilon Then
49     If GuideSweep Then ' on doit EN PLUS vérifier que le sweep touche à la courbe
50     If swModel.ClosestDistance(Me.BodySweep, Sommet1, Nothing, Nothing) < Epsilon AndAlso swModel.ClosestDistance(Me.BodySweep, sommet2, Nothing, Nothing) < Epsilon Then AreteCoque = aretes(z) : Exit Sub
51     Else ' ok automatiquement
52     AreteCoque = aretes(z)
53     Exit Sub
54     End If
55     End If
56     End If
57     Next z
58     Next swFaceV
59    
60    
61     ' 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...
62     DerniereCoupe = True
63     Dim PointNext(2) As Double
64     Dim eArete As SuperArete
65     For Each swFaceV As SldWorks.Face2 In swFaceVol
66     For z = 0 To UBound(aretes)
67     Sommet1 = aretes(z).GetStartVertex()
68     eArete = New SuperArete(aretes(z), True)
69     eArete.Evaluer(eArete.GetTMin + 10 * Epsilon, PointNext)
70     'Commun.MettreUnPoint(PointNext(0), PointNext(1), PointNext(2))
71     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
72    
73     sommet2 = aretes(z).GetEndVertex()
74     eArete = New SuperArete(aretes(z), True)
75     eArete.Evaluer(eArete.GetTMax - 10 * Epsilon, PointNext)
76     'Commun.MettreUnPoint(PointNext(0), PointNext(1), PointNext(2))
77     'eArete.Colorer(z, z / 4, z / 4, z / 4)
78     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
79     Next z
80     Next swFaceV
81    
82     MsgBox("la bonne arète n'a pas été trouvée" & vbCr & eArete.ToString)
83    
84    
85     End Sub
86    
87    
88     ''' <summary>
89     ''' Sub qui dessine le sweep à l'endroit d'intersection
90     ''' </summary>
91     ''' <remarks>Je pourrais couper et mettre les faces internes ici, mais je préfère séparer...</remarks>
92     Public Sub GénérerSweep(Optional ByRef sketch As SldWorks.Sketch = Nothing)
93     ' on peut essayer 2 méthodes, celle du offset des faces et celle du sweep d'un cercle
94     ' celle du offset ne marche pas dans toutes les circonstances...
95     Dim swEnt As SldWorks.Entity
96    
97     If sketch Is Nothing Then
98     If Me.AreteCoque Is Nothing Then Me.QuelleAreteCoqueToucheVolume()
99    
100     ' on ignore le sketch pour l'instant, et on recréé un nouveau sketch qui convertit l'arète de la coque
101     swModel.Insert3DSketch2(False)
102     swEnt = Me.AreteCoque : swEnt.Select4(False, Nothing)
103     Dim skManager As SldWorks.SketchManager = swModel.SketchManager
104     skManager.SketchUseEdge(False)
105     ' ici on doit le prolonger si besoin est
106    
107     sketch = swModel.GetActiveSketch2()
108     swModel.Insert3DSketch2(False)
109     End If
110    
111    
112    
113     ' technique du sweep du cercle
114     ' 1 - trace de la ligne d'intersection
115     ' en théorie c'est déjà fait et on a interFF.sketch qui a le sketch d'intersection...
116    
117     ' 2- Placer un plan à l'extrémité
118     Dim Plan As SldWorks.RefPlane
119    
120     Dim vSeg As Object 'SldWorks.SketchSegment
121     Dim seg As SldWorks.SketchSegment
122     Dim skPoint As SldWorks.SketchPoint = Nothing
123    
124    
125     vSeg = sketch.GetSketchSegments() : seg = vSeg(0)
126    
127     Select Case seg.GetType ' faut faire attention, si le sketch est fermé, ça peut chier des taque pour séelectionner le point
128     Case SwConst.swSketchSegments_e.swSketchLINE
129     Dim skline As SldWorks.SketchLine = seg
130     skPoint = skline.GetStartPoint2()
131    
132     Case SwConst.swSketchSegments_e.swSketchARC
133     Dim skarc As SldWorks.SketchArc = seg
134     skPoint = skarc.GetStartPoint2()
135     Case SwConst.swSketchSegments_e.swSketchELLIPSE
136     Dim skellipse As SldWorks.SketchEllipse = seg
137     skPoint = skellipse.GetStartPoint2()
138     If skPoint Is Nothing Then
139     ' couper l'ellipse
140     MsgBox("On a pas de startpoint sur cette ellipse")
141     End If
142     Case SwConst.swSketchSegments_e.swSketchSPLINE
143     Dim skSpline As SldWorks.SketchSpline = seg
144     Dim vPoints As Object
145     vPoints = skSpline.GetPoints2()
146     skPoint = vPoints(0)
147     Case SwConst.swSketchSegments_e.swSketchPARABOLA
148     Dim skPara As SldWorks.SketchParabola = seg
149     skPoint = skPara.GetStartPoint2()
150     Case Else
151     MsgBox(" Là y'a un problème! (case else....)")
152     End Select
153    
154     seg.Select4(False, Nothing)
155     skPoint.Select4(True, Nothing)
156    
157     Plan = swModel.CreatePlanePerCurveAndPassPoint3(True, False) ' le premier true met l'origine sur le point de la courbe, le second false est pour la visualisation.
158    
159     ' 3 - on créé un cercle sur le plan
160     Dim rayon As Double
161     Dim sface As SlyFaceCoque = Me.sFaceCoque
162     Dim feat As SldWorks.Feature
163     Dim sketchCercle As SldWorks.Sketch
164    
165     rayon = sface.GetEpaisseur
166     swEnt = Plan : swEnt.Select4(False, Nothing)
167    
168     swModel.InsertSketch2(False)
169     swModel.CreateCircleByRadius2(0, 0, 0, rayon)
170     swModel.InsertSketch2(True)
171    
172     feat = swModel.FeatureByPositionReverse(0)
173     sketchCercle = feat.GetSpecificFeature2()
174    
175     ' 4 - Sweep
176     Dim swFeatManager As SldWorks.FeatureManager = swModel.FeatureManager
177    
178     Dim merge As Boolean = False
179    
180     swEnt = sketchCercle : swEnt.Select2(False, 1)
181     swEnt = sketch : swEnt.Select2(True, 4)
182    
183     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.
184    
185     If feat Is Nothing Then
186     swEnt = sketchCercle : swEnt.Select2(False, 1)
187     swEnt = sketch : swEnt.Select2(True, 4)
188     feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, 0, 0, False, 0, 0, 0, 0, 0, 1, 1, 0, 1)
189     End If
190    
191     If feat Is Nothing Then
192     ' il est possible que la coque soit une spline
193     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!")
194     ' on pourrait éventuellement appliquer une autre méthode.
195     Exit Sub
196     End If
197    
198     Dim vfaces As Object = feat.GetFaces
199     Dim swface As SldWorks.Face2 = vfaces(0)
200     Me.BodySweep = swface.GetBody
201    
202    
203     If Me.BodySweep Is Nothing Then MsgBox(feat.Name)
204    
205     End Sub
206    
207    
208 bournival 46
209 bournival 40 ''' <summary>
210     ''' 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.
211     ''' </summary>
212     ''' <remarks>Utile pour les intersections coque-volume seulement (pour l'instant)</remarks>
213     Public Sub DécouperVolume()
214     If Me.BodySweep Is Nothing Then Exit Sub
215    
216     ' sélectionner toutes les faces du sweep avec un mark de 16
217     Dim swFace As SldWorks.Face2 = Me.BodySweep.GetFirstFace()
218     Dim swent As SldWorks.Entity
219     Dim featmanager As SldWorks.FeatureManager
220     Dim feat As SldWorks.Feature = Nothing
221     Dim faces() As SldWorks.Face2
222     Dim sface As SlyFaceVolume = Me.sFaceVolume ' la face du volume
223     Dim swface2 As SldWorks.Face2
224    
225    
226     ' ***** Découpage du volume****
227     swModel.EditRebuild3()
228     featmanager = swModel.FeatureManager
229    
230     faces = sface.GetFaces
231     Dim scoque As SlyFaceCoque = Me.sFaceCoque
232    
233    
234     For Each swface2 In faces
235     If swModel.ClosestDistance(swface2, Me.BodySweep, Nothing, Nothing) < Epsilon Then
236    
237     swModel.ClearSelection2(True)
238     Do While swFace IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
239     swent = swFace : swent.Select2(True, 16)
240     swFace = swFace.GetNextFace
241     Loop
242    
243     ' sélection de la bonne face de coque:
244     'swent = swfaceCoque : swent.Select2(True, 16)
245     Me.SelectionneBonneCoque(True, 16)
246    
247     swent = swface2 : swent.Select2(True, 32)
248    
249     feat = featmanager.InsertSplitLineIntersect(7)
250     If feat IsNot Nothing Then Exit For
251    
252     End If
253     Next
254    
255     Me.BodySweep.HideBody(True)
256    
257     ' ajout des nouvelles faces
258     Dim vfaces As Object = feat.GetFaces()
259     'Dim swFaceBonne As SldWorks.Face2 = Nothing
260     'Dim PointTouche(2) As Double ' attention, ce n'est plus un midpoint...
261     'Dim eArete As New SuperArete(Me.AreteCoque, True)
262     'If Me.PointQuiTouche(0) = -999 Then PointTouche = eArete.GetPointMilieu() Else PointTouche = Me.PointQuiTouche
263     ' swModel.ClearSelection2(True)
264    
265     For Each swFace In vfaces ' sélectionne les faces découpées.
266     sface.AjouterFace(swFace)
267     Next
268    
269     End Sub
270    
271     ''' <summary>
272     ''' S'il y a plus d'une face dans la coque, cette sub sélectionne la bonne face (celle qui touche au sweep)
273     ''' </summary>
274     ''' <param name="Append"></param>
275     ''' <param name="Mark"></param>
276     ''' <remarks></remarks>
277     Private Sub SelectionneBonneCoque(ByRef Append As Boolean, ByRef Mark As Integer)
278     Dim swEnt As SldWorks.Entity
279     Dim vfaces() As SldWorks.Face2 = Me.sFaceCoque.GetFaces
280    
281     If UBound(vfaces) = 0 Then swEnt = vfaces(0) : swEnt.Select2(Append, Mark) : Exit Sub
282    
283     ' bon, on a plusieurs faces pour représenter la coque, il faut trouver celle qui est à l'intérieur du sweep
284     ' celles dont une arête ne touche pas au sweep est Out.
285     ' possible qu'il y ait un cas fucké où ça ne marche pas.
286     For Each swFace As SldWorks.Face2 In vfaces
287     Dim vedges As Object = swFace.GetEdges
288     Dim prendre As Boolean = True
289    
290     For Each swArete As SldWorks.Edge In vedges
291     If swModel.ClosestDistance(Me.BodySweep, swArete, Nothing, Nothing) > Epsilon Then prendre = False : Continue For
292     Next
293    
294     If prendre Then swEnt = swFace : swEnt.Select2(Append, Mark) : Exit Sub
295     Next
296    
297    
298     MsgBox("Rien trouvé!!!")
299    
300     End Sub
301    
302     ''' <summary>
303     ''' 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.
304     ''' </summary>
305     ''' <remarks>Utile pour les intersections coque-volume seulement (pour l'instant)</remarks>
306     Public Sub DecouperCoque()
307     If Me.BodySweep Is Nothing Then Exit Sub
308    
309     DerniereCoupe = False ' pas besoin de redecouper
310     ' on a un sketch avec 2 ou plusieurs segments à l'intérieur
311     ' et si je sélectionnais un segment à la fois et partait un sketch3d, puis je convertis ce segment et construit ce nouveau sketch...
312     Dim vseg As Object = Me.sketch.GetSketchSegments
313     Dim PetitSketch As SldWorks.Sketch = Nothing
314     Dim swSketchManager As SldWorks.SketchManager = swModel.SketchManager
315     'Dim lstFeat As New Collections.Generic.List(Of SldWorks.Feature)
316     Dim swFace As SldWorks.Face2 = Me.BodySweep.GetFirstFace()
317     Dim swent As SldWorks.Entity
318     Dim featmanager As SldWorks.FeatureManager
319     Dim swface2 As SldWorks.Face2
320     Dim scoque As SlyFaceCoque = Me.sFaceCoque
321    
322    
323     For Each segment As SldWorks.SketchSegment In vseg
324     swModel.ClearSelection()
325     If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
326     swModel.Insert3DSketch2(False)
327     segment.Select4(False, Nothing)
328     swSketchManager.SketchUseEdge(False)
329     swModel.Insert3DSketch2(False)
330     swModel.EditRebuild3()
331    
332     Dim feat As SldWorks.Feature = swModel.FeatureByPositionReverse(0)
333     If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
334     PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
335    
336     ' 1 - créer le sweep à partir du sketch
337     Me.GénérerSweep(PetitSketch) ' hahahaha on réutilise la sub !!
338    
339     ' 2 - Couper la coque à partir su sweep
340     swModel.EditRebuild3()
341     featmanager = swModel.FeatureManager
342     Dim faces() As SldWorks.Face2 = scoque.GetFaces
343     For Each swface2 In faces ' les faces de la coque
344     If swModel.ClosestDistance(swface2, Me.BodySweep, Nothing, Nothing) < Epsilon Then
345     swModel.ClearSelection2(True)
346     swFace = Me.BodySweep.GetFirstFace()
347     Do While swFace IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
348     swent = swFace : swent.Select2(True, 16)
349     swFace = swFace.GetNextFace
350     Loop
351     swent = swface2 : swent.Select2(True, 32) ' la face qui est coupée
352     feat = featmanager.InsertSplitLineIntersect(7)
353     'If feat IsNot Nothing Then lstFeat.Add(feat)
354     End If
355     Next
356     Me.BodySweep.HideBody(True)
357    
358     ' rajout des nouvelles faces à la coque
359     feat = swModel.FeatureByPositionReverse(0)
360     Dim vFaces As Object = feat.GetFaces()
361     For Each swFace In vFaces
362     Me.sFaceCoque.AjouterFace(swFace)
363     Next
364    
365     Next
366    
367    
368    
369    
370     End Sub
371    
372    
373     ''' <summary>
374     ''' Function qui retourne vrai si l'on doit couper la coque
375     ''' </summary>
376     ''' <returns>Vrai si la coque doit être coupée</returns>
377     ''' <remarks></remarks>
378     Public Function DoitCouperCoque() As Boolean
379     Dim vSeg As Object = Me.sketch.GetSketchSegments()
380     If UBound(vSeg) > 0 Then Return True Else Return False
381     End Function
382    
383    
384     ''' <summary>
385     ''' Sub qui met les attributs de faces internes sur les bonnes faces.
386     ''' </summary>
387     ''' <remarks></remarks>
388     Public Sub MarquerFacesInternes()
389     ' bon, là il faut trouver les faces internes... mais: la liste de faces dans la slyface
390     'mais j'ai maintenant un moyen de comparer les arètes.
391     Dim trouve As Boolean = False
392     ' 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!!!
393 bournival 50 Dim swFaces() As sldworks.Face2 = Me.sFaceVolume.GetFaces
394     Dim swAreteCoques() As sldworks.Edge = Me.sFaceCoque.GetAretes
395 bournival 40
396 bournival 50 For Each face As sldworks.Face2 In swFaces
397 bournival 40 Dim sFace As New SuperFace(face, True)
398 bournival 50 Dim swAreteVols() As sldworks.Edge = sFace.GetAretes
399     For Each swAreteVol As sldworks.Edge In swAreteVols
400 bournival 40 Dim e As New SuperArete(swAreteVol, True) : e.Colorer(2, 0, 1, 0)
401 bournival 50 For Each swAreteCoque As sldworks.Edge In swAreteCoques
402 bournival 40 If e.comparer(swAreteCoque) Then
403     sFace.MettreAttributFaceInterne()
404     trouve = True : Exit For
405     End If
406     Next
407     If trouve Then trouve = False : Exit For ' on arete de gosser
408     Next
409     Next
410    
411     End Sub
412    
413    
414     End Class