ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterCoqueCoque.vb
Revision: 205
Committed: Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size: 20056 byte(s)
Log Message:
Commit de MAGiC_SLD pendant que j'y pense.  Les modifications ne devraient pas concerner personne d'autre que moi.   -- Sylvain

File Contents

# Content
1 Imports SolidWorks.Interop
2 Imports SolidWorks.Interop.swconst
3 Imports SolidWorks.Interop.swpublished
4
5 Public Class InterCoqueCoque
6 Inherits InterFaceFace
7
8 Public sFaceCoque1 As SlyFaceCoque
9 Public sFaceCoque2 As SlyFaceCoque
10
11 Public AreteCoque1 As SldWorks.Edge
12 Public AreteCoque2 As sldworks.Edge
13
14 Private ADecouper1 As Boolean
15 Private ADecouper2 As Boolean
16 Private FaceAPlat1 As Boolean
17 Private FaceAPlat2 As Boolean
18
19
20 ''' <summary>
21 ''' Nouvelle instance de la classe Intersection Coque Coque.
22 ''' </summary>
23 ''' <param name="coque1">Une des 2 coques</param>
24 ''' <param name="coque2">L'autre</param>
25 ''' <remarks></remarks>
26 Public Sub New(ByRef coque1 As SlyFaceCoque, ByRef coque2 As SlyFaceCoque)
27 sFaceCoque1 = coque1
28 sFaceCoque2 = coque2
29
30 If Commun.OptionMettreNoteIntersection = True Then
31 Dim texte As String = "Intersection # " & Me.Numero & vbCr & "Coque - coque"
32 Dim eface As New SuperFace(sFaceCoque1.SwFace)
33 Dim xyz(2) As Double
34 eface.Evaluer(0.5, 0.5, xyz(0), xyz(1), xyz(2))
35 Commun.CreerAnnotation(xyz(0), xyz(1), xyz(2), texte)
36 eface = Nothing
37
38 eface = New SuperFace(sFaceCoque2.SwFace)
39 eface.Evaluer(0.5, 0.5, xyz(0), xyz(1), xyz(2))
40 Commun.CreerAnnotation(xyz(0), xyz(1), xyz(2), texte)
41 End If
42 End Sub
43
44
45
46
47 ''' <summary>
48 ''' Analyse les 2 coques qui se touchent et détermine de quel type il s'agit.
49 ''' </summary>
50 ''' <remarks></remarks>
51 Public Sub DetermineType()
52
53
54
55 ' si les faces reposent une sur l'autre, on doit leur faire un traitement particulier
56 If Intersections.ComparerSurfaces(sFaceCoque1.SwFace.GetSurface, sFaceCoque2.SwFace.GetSurface) Then
57 ADecouper1 = False
58 ADecouper2 = False
59 FaceAPlat1 = True
60 FaceAPlat2 = True
61 Exit Sub
62 End If
63
64
65 'ADecouper1 = True ' les 2 coques doivent être coupées si on veut leur mettre des mini-poutres.
66 'ADecouper2 = True
67 'FaceAPlat1 = False
68 'FaceAPlat2 = False
69 Nb_segments_intersection()
70
71 ' si on a on a plus d'un segment alors on doit couper les 2 coques
72
73
74 End Sub
75
76
77
78 Private Sub Nb_segments_intersection()
79 swModel.ClearSelection2(True)
80
81 Me.sFaceCoque2.SelectionnerToutes(, False)
82 Me.sFaceCoque1.SelectionnerToutes(, True)
83
84
85 swModel.Sketch3DIntersections()
86 swModel.ClearSelection2(True)
87 swModel.Sketch3DIntersections()
88 swModel.ClearSelection2(True)
89 swModel.SketchManager.InsertSketch(True)
90
91 Dim sketchFeat1 As sldworks.Feature = swModel.FeatureByPositionReverse(0)
92 Dim swsketch1 As sldworks.Sketch = sketchFeat1.GetSpecificFeature2
93
94
95 Dim objsketch As Object = swsketch1.GetSketchSegments()
96 'Dim sketchsegments() As sldworks.SketchSegment = objsketch
97 Dim sketchsegments1() As sldworks.SketchSegment
98 ReDim sketchsegments1(UBound(objsketch))
99
100 For i As Integer = 0 To UBound(objsketch)
101 sketchsegments1(i) = objsketch(i)
102 Next i
103
104
105 Dim premier As Boolean = False
106 Dim second As Boolean = False
107
108 If UBound(sketchsegments1) > 0 Then
109 ADecouper1 = True : ADecouper2 = True
110 Exit Sub
111
112 Else
113 ' si une arête de la coque touche l'autre coque à 2 sommets de la coque
114 Dim swent As sldworks.Entity = swsketch1 : swent.Select2(False, 1)
115 swModel.InsertCompositeCurve()
116
117 Dim swFeat As sldworks.Feature = swModel.FeatureByPositionReverse(0)
118
119 If swFeat.GetTypeName() = "CompositeCurve" Then
120
121 Dim refcurve As sldworks.ReferenceCurve = swFeat.GetSpecificFeature2()
122 Dim swEdge As sldworks.Edge = refcurve.GetFirstSegment()
123
124 Dim e As New SuperArete(swEdge, True)
125 Dim aretes1() As sldworks.Edge = Me.sFaceCoque1.GetAretes
126 Dim aretes2() As sldworks.Edge = Me.sFaceCoque2.GetAretes
127
128 For i As Integer = 0 To aretes1.GetUpperBound(0)
129 If e.comparer(aretes1(i)) Then premier = True : Exit For
130 Next
131
132 For i As Integer = 0 To aretes2.GetUpperBound(0)
133 If e.comparer(aretes2(i)) Then second = True : Exit For
134 Next
135
136 If premier Then ADecouper1 = False Else ADecouper1 = True
137 If second Then ADecouper2 = False Else ADecouper2 = True
138 If premier And second Then ADecouper1 = True : ADecouper2 = True
139
140
141 End If
142
143 ' on efface la courbe
144 swFeat.Select2(False, 0)
145 Dim ext As sldworks.ModelDocExtension = swModel.Extension
146 ext.DeleteSelection2(swconst.swDeleteSelectionOptions_e.swDelete_Children)
147
148 End If
149
150
151 End Sub
152
153
154
155
156
157 ''' <summary>
158 ''' Si vrai, alors on a une intersection de face à plat
159 ''' </summary>
160 ''' <value></value>
161 ''' <returns></returns>
162 ''' <remarks></remarks>
163 Public ReadOnly Property FaceAPlat() As Boolean
164 Get
165 Return FaceAPlat1
166 End Get
167 End Property
168
169 ''' <summary>
170 ''' Vrai si on doit couper la coque #1
171 ''' </summary>
172 ''' <value></value>
173 ''' <returns></returns>
174 ''' <remarks></remarks>
175 Public ReadOnly Property DoitCouperCoque1() As Boolean
176 Get
177 Return ADecouper1
178 End Get
179 End Property
180
181 ''' <summary>
182 ''' Vrai si on doit couper la coque #2
183 ''' </summary>
184 ''' <value></value>
185 ''' <returns></returns>
186 ''' <remarks></remarks>
187 Public ReadOnly Property DoitCouperCoque2() As Boolean
188 Get
189 Return ADecouper2
190 End Get
191 End Property
192
193
194
195 ''' <summary>
196 ''' Sub qui coupe 2 coques à plat
197 ''' </summary>
198 ''' <remarks></remarks>
199 Public Sub CoupeAPlat()
200 Dim feat As sldworks.Feature = Nothing
201 Dim swEnt As sldworks.Entity
202 Dim sketch(2) As sldworks.Sketch
203 Dim SelMgr As sldworks.SelectionMgr = swModel.SelectionManager
204 Dim nom As String
205 Dim xyz(2) As Double
206
207
208 ' a) faire 1 esquisses 3D
209
210 swModel.ClearSelection2(True)
211 swModel.Insert3DSketch2(True)
212 swEnt = Me.sFaceCoque1.SwFace() : swEnt.Select(False)
213 swEnt = Me.sFaceCoque2.SwFace() : swEnt.Select(True)
214 swModel.Sketch3DIntersections()
215 swModel.SketchManager.InsertSketch(True)
216 feat = swModel.FeatureByPositionReverse(0)
217 nom = feat.Name
218
219
220 ' b) Remplir la surface
221 Dim vPatchBoundaries As Object
222 swModel.Extension.SelectByID2(nom, "SKETCH", 0, 0, 0, False, 1, Nothing, 0)
223 vPatchBoundaries = SelMgr.GetSelectedObject2(1)
224 swModel.FeatureManager.InsertFillSurface2(3, swconst.swFeatureFillSurfaceOptions_e.swOptimizeSurface, vPatchBoundaries, swconst.swContactType_e.swContact, Nothing, Nothing)
225
226
227 ' On coupe une surface
228 swModel.ClearSelection2(True)
229 swModel.Insert3DSketch2(True)
230 swEnt = Me.sFaceCoque1.SwFace() : swEnt.Select2(False, 0)
231 swEnt = Me.sFaceCoque2.SwFace() : swEnt.Select2(True, 0)
232 swModel.Sketch3DIntersections()
233 swModel.SketchManager.InsertSketch(True)
234 feat = swModel.FeatureByPositionReverse(0)
235 sketch(0) = feat.GetSpecificFeature2()
236 If PointAGarder(Me.sFaceCoque1, Me.sFaceCoque2, xyz) Then
237 Commun.MettreUnPoint(xyz(0), xyz(1), xyz(2))
238 swModel.Extension.SelectByID2("", "BODYFEATURE", 0, 0, 0, True, 0, Nothing, 0)
239 swModel.FeatureManager.PreTrimSurface(0, 1, 0, 0)
240 swModel.Extension.SelectByID2("", "SURFACEBODY", xyz(0), xyz(1), xyz(2), True, 0, Nothing, 0) '-0.04387817789132, -0.03087621363591, -0.02079408480836, True, 0, Nothing, 0)
241 swModel.FeatureManager.PostTrimSurface(1)
242 End If
243
244
245 '' on coupe l'autre surface
246 swModel.ClearSelection2(True)
247 If PointAGarder(Me.sFaceCoque2, Me.sFaceCoque1, xyz) Then
248 Commun.MettreUnPoint(xyz(0), xyz(1), xyz(2))
249 swModel.Extension.SelectByID2("", "BODYFEATURE", 0, 0, 0, True, 0, Nothing, 0)
250 swModel.FeatureManager.PreTrimSurface(0, 1, 0, 0)
251 swModel.Extension.SelectByID2("", "SURFACEBODY", xyz(0), xyz(1), xyz(2), True, 0, Nothing, 0) '-0.04387817789132, -0.03087621363591, -0.02079408480836, True, 0, Nothing, 0)
252 swModel.FeatureManager.PostTrimSurface(1)
253 End If
254
255
256 End Sub
257
258
259 ''' <summary>
260 ''' Function qui retourne un point qui appartient à la face1 et pas à la face2
261 ''' </summary>
262 ''' <returns></returns>
263 ''' <remarks></remarks>
264 Private Function PointAGarder(ByRef Face1 As SuperFace, ByRef Face2 As SuperFace, ByRef XYZ() As Double) As Boolean
265 Dim u As Double
266 Dim v As Double
267 Dim umin As Double
268 Dim vmin As Double
269 Dim umax As Double
270 Dim vmax As Double
271
272
273 Face1.UVMinMax(umin, umax, vmin, vmax)
274 u = umin
275 v = vmin
276 Dim incV As Double = (vmax - vmin) / 100
277 Dim incU As Double = (umax - umin) / 100
278
279 Do While u <= umax
280 u += incU
281 Do While v < vmax
282 v += incV
283 If Not Face1.Evaluer(u, v, XYZ(0), XYZ(1), XYZ(2)) Then Continue Do
284 If Commun.Distance(Face2, XYZ(0), XYZ(1), XYZ(2)) > 100 * Epsilon Then Return True
285 Loop
286
287 Loop
288
289 Return False
290
291
292 End Function
293
294
295
296 ''' <summary>
297 ''' Sub qui dessine le sweep à l'endroit d'intersection
298 ''' </summary>
299 ''' <remarks>Je pourrais couper et mettre les faces internes ici, mais je préfère séparer...</remarks>
300 Public Function GénérerSweep(ByRef sketch As SldWorks.Sketch, ByVal rayon As Double) As SldWorks.Body2
301
302 Dim swEnt As SldWorks.Entity
303
304 ' technique du sweep du cercle
305 ' 1 - trace de la ligne d'intersection
306 ' en théorie c'est déjà fait et on a interFF.sketch qui a le sketch d'intersection...
307
308 ' 2- Placer un plan à l'extrémité
309 Dim Plan As SldWorks.RefPlane
310
311 Dim vSeg As Object 'SldWorks.SketchSegment
312 Dim seg As SldWorks.SketchSegment
313 Dim skPoint As SldWorks.SketchPoint = Nothing
314
315 'MsgBox("Nombre de points dans le sketch " & sketch.GetSketchPointsCount2())
316 Dim nbpoints As Integer = sketch.GetSketchPointsCount2() ' étrangement, si on a pas ça ça plante!!!
317
318 vSeg = sketch.GetSketchSegments() : seg = vSeg(0)
319
320 Select Case seg.GetType ' faut faire attention, si le sketch est fermé, ça peut chier des taque pour séelectionner le point
321 Case swconst.swSketchSegments_e.swSketchLINE
322 Dim skline As SldWorks.SketchLine = seg
323 skPoint = skline.GetStartPoint2()
324
325 Case swconst.swSketchSegments_e.swSketchARC
326 Dim skarc As SldWorks.SketchArc = seg
327 skPoint = skarc.GetStartPoint2()
328 Case swconst.swSketchSegments_e.swSketchELLIPSE
329 Dim skellipse As SldWorks.SketchEllipse = seg
330 skPoint = skellipse.GetStartPoint2()
331 If skPoint Is Nothing Then
332 ' couper l'ellipse
333 MsgBox("On a pas de startpoint sur cette ellipse")
334 End If
335 Case swconst.swSketchSegments_e.swSketchSPLINE
336 Dim skSpline As SldWorks.SketchSpline = seg
337 Dim vPoints As Object
338 vPoints = skSpline.GetPoints2()
339 skPoint = vPoints(0)
340 Case swconst.swSketchSegments_e.swSketchPARABOLA
341 Dim skPara As SldWorks.SketchParabola = seg
342 skPoint = skPara.GetStartPoint2()
343 Case Else
344 MsgBox(" Là y'a un problème! (case else....)")
345 End Select
346
347 seg.Select4(False, Nothing)
348 skPoint.Select4(True, Nothing)
349
350 Plan = swModel.CreatePlanePerCurveAndPassPoint3(True, False) ' le premier true met l'origine sur le point de la courbe, le second false est pour la visualisation.
351
352 ' 3 - on créé un cercle sur le plan
353 'Dim rayon As Double
354 'Dim sface As SlyFaceCoque = Me.sFaceCoque
355 Dim feat As SldWorks.Feature
356 Dim sketchCercle As SldWorks.Sketch
357
358 ' rayon = sface.GetEpaisseur
359 swEnt = Plan : swEnt.Select4(False, Nothing)
360
361 swModel.InsertSketch2(False)
362 swModel.CreateCircleByRadius2(0, 0, 0, rayon)
363 swModel.InsertSketch2(True)
364
365 feat = swModel.FeatureByPositionReverse(0)
366 sketchCercle = feat.GetSpecificFeature2()
367
368 ' 4 - Sweep
369 Dim swFeatManager As SldWorks.FeatureManager = swModel.FeatureManager
370
371 Dim merge As Boolean = False
372
373 swEnt = sketchCercle : swEnt.Select2(False, 1)
374 swEnt = sketch : swEnt.Select2(True, 4)
375
376 feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, swTangencyType_e.swTangencyNone, swTangencyType_e.swTangencyNone, False, 0, 0, 0, 0, 0, 1, 1, 0, 1)
377 If feat Is Nothing Then
378 swEnt = sketchCercle : swEnt.Select2(False, 1)
379 swEnt = sketch : swEnt.Select2(True, 4)
380 feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, swTangencyType_e.swTangencyNone, swTangencyType_e.swTangencyNone, False, 0, 0, 0, 0, 0, 1, 1, 0, 1)
381 End If
382
383 If feat Is Nothing Then
384 ' il est possible que la coque soit une spline
385 '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!")
386 Err.Raise(600)
387 ' on pourrait éventuellement appliquer une autre méthode.
388 Return Nothing
389 End If
390
391 Dim vfaces As Object = feat.GetFaces
392 Dim swface As SldWorks.Face2 = vfaces(0)
393 Me.BodySweep = swface.GetBody
394
395
396 If Me.BodySweep Is Nothing Then MsgBox(feat.Name)
397 Return Me.BodySweep
398
399 End Function
400
401 ''' <summary>
402 '''
403 ''' </summary>
404 ''' <param name="LaCoque"></param>
405 ''' <param name="sweep"></param>
406 ''' <remarks></remarks>
407 Public Sub DecouperCoque(ByRef LaCoque As SlyFaceCoque, ByRef sweep As SldWorks.Body2)
408 If Me.BodySweep Is Nothing Then Exit Sub
409
410
411 ' on a un sketch avec 2 ou plusieurs segments à l'intérieur
412 ' et si je sélectionnais un segment à la fois et partait un sketch3d, puis je convertis ce segment et construit ce nouveau sketch...
413 Dim vseg As Object = Me.sketch.GetSketchSegments
414 Dim PetitSketch As SldWorks.Sketch = Nothing
415 Dim swSketchManager As SldWorks.SketchManager = swModel.SketchManager
416 'Dim lstFeat As New Collections.Generic.List(Of SldWorks.Feature)
417 Dim swFace As SldWorks.Face2 = Me.BodySweep.GetFirstFace()
418 Dim swent As SldWorks.Entity
419 Dim featmanager As SldWorks.FeatureManager
420 Dim swface2 As SldWorks.Face2
421 Dim LautreCoque As SlyFaceCoque
422 LautreCoque = IIf(LaCoque Is Me.sFaceCoque1, Me.sFaceCoque2, Me.sFaceCoque1)
423
424
425 For Each segment As SldWorks.SketchSegment In vseg
426 swModel.ClearSelection()
427 If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
428 swModel.Insert3DSketch2(False)
429 segment.Select4(False, Nothing)
430 swSketchManager.SketchUseEdge(False)
431 swModel.Insert3DSketch2(False)
432 swModel.EditRebuild3()
433
434 Dim feat As SldWorks.Feature = swModel.FeatureByPositionReverse(0)
435 If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
436 PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
437
438
439 ' 2 - Couper la coque à partir du sweep
440 swModel.EditRebuild3()
441 featmanager = swModel.FeatureManager
442 Dim faces() As sldworks.Face2 = LaCoque.GetFaces ' les faces de la coque qui sont découpées
443 Debug.Print(LaCoque.GetEpaisseur)
444 Debug.Print(sweep.Name)
445
446
447 'aller chercher le surface body et demander toutes les faces...
448 swface2 = faces(0)
449 Dim swbody As sldworks.Body2 = swface2.GetBody()
450 Debug.Print(swbody.GetFaceCount)
451 swface2 = swbody.GetFirstFace
452 While swface2 IsNot Nothing 'For Each swface2 In faces ' les faces de la coque
453
454 feat = Nothing
455 Debug.Print(swface2.GetArea)
456 If swModel.ClosestDistance(swface2, sweep, Nothing, Nothing) < Epsilon Then
457 swModel.ClearSelection2(True)
458 swFace = sweep.GetFirstFace()
459 Do While swFace IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
460 swent = swFace : swent.Select2(True, 16)
461 swFace = swFace.GetNextFace
462 Loop
463 LautreCoque.SelectionnerToutes(16, True)
464
465 swent = swface2 : swent.Select2(True, 32) ' la face qui est coupée
466 feat = featmanager.InsertSplitLineIntersect(7)
467 ' si on coupe bien une face, les pointeurs peuvent revenir à 0 et on peut ignorer une face...
468 If feat IsNot Nothing Then
469 ' rajout des nouvelles faces à la coque
470 feat = swModel.FeatureByPositionReverse(0)
471 Dim vFaces As Object = feat.GetFaces()
472 For Each swFace In vFaces
473 LaCoque.AjouterFace(swFace)
474 Next
475 End If
476 End If
477 swface2 = swface2.GetNextFace()
478 End While
479
480
481 Next
482 sweep.HideBody(True)
483 End Sub
484
485
486 ''' <summary>
487 ''' Sub qui met les attributs de faces internes sur les bonnes faces.
488 ''' </summary>
489 ''' <remarks></remarks>
490 Public Sub MarquerFacesInternes(ByRef CoqueCoupante As SlyFaceCoque, ByRef CoqueCoupee As SlyFaceCoque)
491 ' bon, là il faut trouver les faces internes... mais: la liste de faces dans la slyface
492 'mais j'ai maintenant un moyen de comparer les arètes.
493 Dim trouve As Boolean = False
494 ' 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!!!
495 Dim swFaces() As SldWorks.Face2 = CoqueCoupee.GetFaces
496 Dim swAreteCoques() As SldWorks.Edge = CoqueCoupante.GetAretes
497
498 For Each face As SldWorks.Face2 In swFaces
499 Dim sFace As New SuperFace(face, True)
500 Dim swAreteVols() As SldWorks.Edge = sFace.GetAretes
501 For Each swAreteVol As SldWorks.Edge In swAreteVols
502 Dim e As New SuperArete(swAreteVol, True) : e.Colorer(2, 0, 1, 0)
503 For Each swAreteCoque As SldWorks.Edge In swAreteCoques
504 If e.comparer(swAreteCoque) Then
505 sFace.MettreAttributFaceInterne(sFace.SwFace, CoqueCoupante.GetEpaisseur / 4, False)
506 trouve = True : Exit For
507 End If
508 Next
509 If trouve Then trouve = False : Exit For ' on arete de gosser
510 Next
511 Next
512
513
514 End Sub
515
516
517
518 End Class