ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterCoqueVolume.vb
Revision: 46
Committed: Wed Aug 22 18:28:53 2007 UTC (17 years, 8 months ago) by bournival
File size: 18391 byte(s)
Log Message:
Ajout de la page de pré-optimisation automatique et des modification que j'ai apportées.

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
205 ''' <summary>
206 ''' 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.
207 ''' </summary>
208 ''' <remarks>Utile pour les intersections coque-volume seulement (pour l'instant)</remarks>
209 Public Sub DécouperVolume()
210 If Me.BodySweep Is Nothing Then Exit Sub
211
212 ' sélectionner toutes les faces du sweep avec un mark de 16
213 Dim swFace As SldWorks.Face2 = Me.BodySweep.GetFirstFace()
214 Dim swent As SldWorks.Entity
215 Dim featmanager As SldWorks.FeatureManager
216 Dim feat As SldWorks.Feature = Nothing
217 Dim faces() As SldWorks.Face2
218 Dim sface As SlyFaceVolume = Me.sFaceVolume ' la face du volume
219 Dim swface2 As SldWorks.Face2
220
221
222 ' ***** Découpage du volume****
223 swModel.EditRebuild3()
224 featmanager = swModel.FeatureManager
225
226 faces = sface.GetFaces
227 Dim scoque As SlyFaceCoque = Me.sFaceCoque
228
229
230 For Each swface2 In faces
231 If swModel.ClosestDistance(swface2, Me.BodySweep, Nothing, Nothing) < Epsilon Then
232
233 swModel.ClearSelection2(True)
234 Do While swFace IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
235 swent = swFace : swent.Select2(True, 16)
236 swFace = swFace.GetNextFace
237 Loop
238
239 ' sélection de la bonne face de coque:
240 'swent = swfaceCoque : swent.Select2(True, 16)
241 Me.SelectionneBonneCoque(True, 16)
242
243 swent = swface2 : swent.Select2(True, 32)
244
245 feat = featmanager.InsertSplitLineIntersect(7)
246 If feat IsNot Nothing Then Exit For
247
248 End If
249 Next
250
251 Me.BodySweep.HideBody(True)
252
253 ' ajout des nouvelles faces
254 Dim vfaces As Object = feat.GetFaces()
255 'Dim swFaceBonne As SldWorks.Face2 = Nothing
256 'Dim PointTouche(2) As Double ' attention, ce n'est plus un midpoint...
257 'Dim eArete As New SuperArete(Me.AreteCoque, True)
258 'If Me.PointQuiTouche(0) = -999 Then PointTouche = eArete.GetPointMilieu() Else PointTouche = Me.PointQuiTouche
259 ' swModel.ClearSelection2(True)
260
261 For Each swFace In vfaces ' sélectionne les faces découpées.
262 sface.AjouterFace(swFace)
263 Next
264
265 End Sub
266
267 ''' <summary>
268 ''' S'il y a plus d'une face dans la coque, cette sub sélectionne la bonne face (celle qui touche au sweep)
269 ''' </summary>
270 ''' <param name="Append"></param>
271 ''' <param name="Mark"></param>
272 ''' <remarks></remarks>
273 Private Sub SelectionneBonneCoque(ByRef Append As Boolean, ByRef Mark As Integer)
274 Dim swEnt As SldWorks.Entity
275 Dim vfaces() As SldWorks.Face2 = Me.sFaceCoque.GetFaces
276
277 If UBound(vfaces) = 0 Then swEnt = vfaces(0) : swEnt.Select2(Append, Mark) : Exit Sub
278
279 ' bon, on a plusieurs faces pour représenter la coque, il faut trouver celle qui est à l'intérieur du sweep
280 ' celles dont une arête ne touche pas au sweep est Out.
281 ' possible qu'il y ait un cas fucké où ça ne marche pas.
282 For Each swFace As SldWorks.Face2 In vfaces
283 Dim vedges As Object = swFace.GetEdges
284 Dim prendre As Boolean = True
285
286 For Each swArete As SldWorks.Edge In vedges
287 If swModel.ClosestDistance(Me.BodySweep, swArete, Nothing, Nothing) > Epsilon Then prendre = False : Continue For
288 Next
289
290 If prendre Then swEnt = swFace : swEnt.Select2(Append, Mark) : Exit Sub
291 Next
292
293
294 MsgBox("Rien trouvé!!!")
295
296 End Sub
297
298 ''' <summary>
299 ''' 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.
300 ''' </summary>
301 ''' <remarks>Utile pour les intersections coque-volume seulement (pour l'instant)</remarks>
302 Public Sub DecouperCoque()
303 If Me.BodySweep Is Nothing Then Exit Sub
304
305 DerniereCoupe = False ' pas besoin de redecouper
306 ' on a un sketch avec 2 ou plusieurs segments à l'intérieur
307 ' et si je sélectionnais un segment à la fois et partait un sketch3d, puis je convertis ce segment et construit ce nouveau sketch...
308 Dim vseg As Object = Me.sketch.GetSketchSegments
309 Dim PetitSketch As SldWorks.Sketch = Nothing
310 Dim swSketchManager As SldWorks.SketchManager = swModel.SketchManager
311 'Dim lstFeat As New Collections.Generic.List(Of SldWorks.Feature)
312 Dim swFace As SldWorks.Face2 = Me.BodySweep.GetFirstFace()
313 Dim swent As SldWorks.Entity
314 Dim featmanager As SldWorks.FeatureManager
315 Dim swface2 As SldWorks.Face2
316 Dim scoque As SlyFaceCoque = Me.sFaceCoque
317
318
319 For Each segment As SldWorks.SketchSegment In vseg
320 swModel.ClearSelection()
321 If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
322 swModel.Insert3DSketch2(False)
323 segment.Select4(False, Nothing)
324 swSketchManager.SketchUseEdge(False)
325 swModel.Insert3DSketch2(False)
326 swModel.EditRebuild3()
327
328 Dim feat As SldWorks.Feature = swModel.FeatureByPositionReverse(0)
329 If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
330 PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
331
332 ' 1 - créer le sweep à partir du sketch
333 Me.GénérerSweep(PetitSketch) ' hahahaha on réutilise la sub !!
334
335 ' 2 - Couper la coque à partir su sweep
336 swModel.EditRebuild3()
337 featmanager = swModel.FeatureManager
338 Dim faces() As SldWorks.Face2 = scoque.GetFaces
339 For Each swface2 In faces ' les faces de la coque
340 If swModel.ClosestDistance(swface2, Me.BodySweep, Nothing, Nothing) < Epsilon Then
341 swModel.ClearSelection2(True)
342 swFace = Me.BodySweep.GetFirstFace()
343 Do While swFace IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
344 swent = swFace : swent.Select2(True, 16)
345 swFace = swFace.GetNextFace
346 Loop
347 swent = swface2 : swent.Select2(True, 32) ' la face qui est coupée
348 feat = featmanager.InsertSplitLineIntersect(7)
349 'If feat IsNot Nothing Then lstFeat.Add(feat)
350 End If
351 Next
352 Me.BodySweep.HideBody(True)
353
354 ' rajout des nouvelles faces à la coque
355 feat = swModel.FeatureByPositionReverse(0)
356 Dim vFaces As Object = feat.GetFaces()
357 For Each swFace In vFaces
358 Me.sFaceCoque.AjouterFace(swFace)
359 Next
360
361 Next
362
363
364
365
366 End Sub
367
368
369 ''' <summary>
370 ''' Function qui retourne vrai si l'on doit couper la coque
371 ''' </summary>
372 ''' <returns>Vrai si la coque doit être coupée</returns>
373 ''' <remarks></remarks>
374 Public Function DoitCouperCoque() As Boolean
375 Dim vSeg As Object = Me.sketch.GetSketchSegments()
376 If UBound(vSeg) > 0 Then Return True Else Return False
377 End Function
378
379
380 ''' <summary>
381 ''' Sub qui met les attributs de faces internes sur les bonnes faces.
382 ''' </summary>
383 ''' <remarks></remarks>
384 Public Sub MarquerFacesInternes()
385 ' bon, là il faut trouver les faces internes... mais: la liste de faces dans la slyface
386 'mais j'ai maintenant un moyen de comparer les arètes.
387 Dim trouve As Boolean = False
388 ' 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!!!
389 Dim swFaces() As SldWorks.Face2 = Me.sFaceVolume.GetFaces
390 Dim swAreteCoques() As SldWorks.Edge = Me.sFaceCoque.GetAretes
391
392 For Each face As SldWorks.Face2 In swFaces
393 Dim sFace As New SuperFace(face, True)
394 Dim swAreteVols() As SldWorks.Edge = sFace.GetAretes
395 For Each swAreteVol As SldWorks.Edge In swAreteVols
396 Dim e As New SuperArete(swAreteVol, True) : e.Colorer(2, 0, 1, 0)
397 For Each swAreteCoque As SldWorks.Edge In swAreteCoques
398 If e.comparer(swAreteCoque) Then
399 sFace.MettreAttributFaceInterne()
400 trouve = True : Exit For
401 End If
402 Next
403 If trouve Then trouve = False : Exit For ' on arete de gosser
404 Next
405 Next
406
407
408 End Sub
409
410
411 End Class