ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterCoqueVolume.vb
Revision: 130
Committed: Wed Jul 30 21:26:03 2008 UTC (16 years, 9 months ago) by bournival
File size: 34180 byte(s)
Log Message:
Une mise à jour, car on aura peut-être besoin de mon code.

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