ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterCoqueVolume.vb
Revision: 48
Committed: Wed Aug 22 21:18:12 2007 UTC (17 years, 8 months ago) by bournival
File size: 18497 byte(s)
Log Message:
On passe aux nouveaux .dll

File Contents

# Content
1 Imports SolidWorks.Interop
2 Imports SolidWorks.Interop.swconst
3 Imports SolidWorks.Interop.swpublished
4
5 ''' <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
209 ''' <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 Dim swFaces() As SldWorks.Face2 = Me.sFaceVolume.GetFaces
394 Dim swAreteCoques() As SldWorks.Edge = Me.sFaceCoque.GetAretes
395
396 For Each face As SldWorks.Face2 In swFaces
397 Dim sFace As New SuperFace(face, True)
398 Dim swAreteVols() As SldWorks.Edge = sFace.GetAretes
399 For Each swAreteVol As SldWorks.Edge In swAreteVols
400 Dim e As New SuperArete(swAreteVol, True) : e.Colorer(2, 0, 1, 0)
401 For Each swAreteCoque As SldWorks.Edge In swAreteCoques
402 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
412 End Sub
413
414
415 End Class