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

# User Rev Content
1 bournival 48 Imports SolidWorks.Interop
2     Imports SolidWorks.Interop.swconst
3     Imports SolidWorks.Interop.swpublished
4    
5 bournival 40 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 bournival 130 Public AreteCoque2 As sldworks.Edge
13 bournival 40
14 bournival 130 Private ADecouper1 As Boolean
15     Private ADecouper2 As Boolean
16     Private FaceAPlat1 As Boolean
17     Private FaceAPlat2 As Boolean
18    
19    
20 bournival 46 ''' <summary>
21 bournival 130 ''' 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 bournival 205
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 bournival 130 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 bournival 205
55 bournival 130 ' 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 bournival 205 Exit Sub
62 bournival 130 End If
63    
64 bournival 205
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 bournival 130 End Sub
75    
76 bournival 205
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 bournival 130 ''' <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 bournival 46 ''' 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 bournival 40
302 bournival 46 Dim swEnt As SldWorks.Entity
303 bournival 40
304 bournival 46 ' 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 bournival 40
308 bournival 46 ' 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 bournival 205 '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 bournival 46
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 bournival 48 Case swconst.swSketchSegments_e.swSketchLINE
322 bournival 46 Dim skline As SldWorks.SketchLine = seg
323     skPoint = skline.GetStartPoint2()
324    
325 bournival 48 Case swconst.swSketchSegments_e.swSketchARC
326 bournival 46 Dim skarc As SldWorks.SketchArc = seg
327     skPoint = skarc.GetStartPoint2()
328 bournival 48 Case swconst.swSketchSegments_e.swSketchELLIPSE
329 bournival 46 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 bournival 48 Case swconst.swSketchSegments_e.swSketchSPLINE
336 bournival 46 Dim skSpline As SldWorks.SketchSpline = seg
337     Dim vPoints As Object
338     vPoints = skSpline.GetPoints2()
339     skPoint = vPoints(0)
340 bournival 48 Case swconst.swSketchSegments_e.swSketchPARABOLA
341 bournival 46 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 bournival 205 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 bournival 46 If feat Is Nothing Then
378     swEnt = sketchCercle : swEnt.Select2(False, 1)
379     swEnt = sketch : swEnt.Select2(True, 4)
380 bournival 205 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 bournival 46 End If
382    
383     If feat Is Nothing Then
384     ' il est possible que la coque soit une spline
385 bournival 205 '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 bournival 46 ' 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 bournival 205 ' 2 - Couper la coque à partir du sweep
440 bournival 46 swModel.EditRebuild3()
441     featmanager = swModel.FeatureManager
442 bournival 205 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 bournival 46 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 bournival 205 ' 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 bournival 46 End If
477 bournival 205 swface2 = swface2.GetNextFace()
478     End While
479 bournival 46
480    
481     Next
482 bournival 205 sweep.HideBody(True)
483 bournival 46 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 bournival 205 sFace.MettreAttributFaceInterne(sFace.SwFace, CoqueCoupante.GetEpaisseur / 4, False)
506 bournival 46 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 bournival 130
518 bournival 40 End Class