ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterCoqueVolume.vb
Revision: 40
Committed: Mon Aug 20 21:30:28 2007 UTC (17 years, 8 months ago) by bournival
File size: 18389 byte(s)
Log Message:
Projet de these de Sylvain Bournival. Attention projet VB.

File Contents

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