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

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     End Sub
30    
31    
32    
33    
34     ''' <summary>
35     ''' Analyse les 2 coques qui se touchent et détermine de quel type il s'agit.
36     ''' </summary>
37     ''' <remarks></remarks>
38     Public Sub DetermineType()
39    
40     ADecouper1 = True
41     ADecouper2 = True
42     FaceAPlat1 = False
43     FaceAPlat2 = False
44    
45     ' si les faces reposent une sur l'autre, on doit leur faire un traitement particulier
46     If Intersections.ComparerSurfaces(sFaceCoque1.SwFace.GetSurface, sFaceCoque2.SwFace.GetSurface) Then
47     ADecouper1 = False
48     ADecouper2 = False
49     FaceAPlat1 = True
50     FaceAPlat2 = True
51     End If
52    
53     End Sub
54    
55     ''' <summary>
56     ''' Si vrai, alors on a une intersection de face à plat
57     ''' </summary>
58     ''' <value></value>
59     ''' <returns></returns>
60     ''' <remarks></remarks>
61     Public ReadOnly Property FaceAPlat() As Boolean
62     Get
63     Return FaceAPlat1
64     End Get
65     End Property
66    
67     ''' <summary>
68     ''' Vrai si on doit couper la coque #1
69     ''' </summary>
70     ''' <value></value>
71     ''' <returns></returns>
72     ''' <remarks></remarks>
73     Public ReadOnly Property DoitCouperCoque1() As Boolean
74     Get
75     Return ADecouper1
76     End Get
77     End Property
78    
79     ''' <summary>
80     ''' Vrai si on doit couper la coque #2
81     ''' </summary>
82     ''' <value></value>
83     ''' <returns></returns>
84     ''' <remarks></remarks>
85     Public ReadOnly Property DoitCouperCoque2() As Boolean
86     Get
87     Return ADecouper2
88     End Get
89     End Property
90    
91    
92    
93     ''' <summary>
94     ''' Sub qui coupe 2 coques à plat
95     ''' </summary>
96     ''' <remarks></remarks>
97     Public Sub CoupeAPlat()
98     Dim feat As sldworks.Feature = Nothing
99     Dim swEnt As sldworks.Entity
100     Dim sketch(2) As sldworks.Sketch
101     Dim SelMgr As sldworks.SelectionMgr = swModel.SelectionManager
102     Dim nom As String
103     Dim xyz(2) As Double
104    
105    
106     ' a) faire 1 esquisses 3D
107    
108     swModel.ClearSelection2(True)
109     swModel.Insert3DSketch2(True)
110     swEnt = Me.sFaceCoque1.SwFace() : swEnt.Select(False)
111     swEnt = Me.sFaceCoque2.SwFace() : swEnt.Select(True)
112     swModel.Sketch3DIntersections()
113     swModel.SketchManager.InsertSketch(True)
114     feat = swModel.FeatureByPositionReverse(0)
115     nom = feat.Name
116    
117    
118     ' b) Remplir la surface
119     Dim vPatchBoundaries As Object
120     swModel.Extension.SelectByID2(nom, "SKETCH", 0, 0, 0, False, 1, Nothing, 0)
121     vPatchBoundaries = SelMgr.GetSelectedObject2(1)
122     swModel.FeatureManager.InsertFillSurface2(3, swconst.swFeatureFillSurfaceOptions_e.swOptimizeSurface, vPatchBoundaries, swconst.swContactType_e.swContact, Nothing, Nothing)
123    
124    
125     ' On coupe une surface
126     swModel.ClearSelection2(True)
127     swModel.Insert3DSketch2(True)
128     swEnt = Me.sFaceCoque1.SwFace() : swEnt.Select2(False, 0)
129     swEnt = Me.sFaceCoque2.SwFace() : swEnt.Select2(True, 0)
130     swModel.Sketch3DIntersections()
131     swModel.SketchManager.InsertSketch(True)
132     feat = swModel.FeatureByPositionReverse(0)
133     sketch(0) = feat.GetSpecificFeature2()
134     If PointAGarder(Me.sFaceCoque1, Me.sFaceCoque2, xyz) Then
135     Commun.MettreUnPoint(xyz(0), xyz(1), xyz(2))
136     swModel.Extension.SelectByID2("", "BODYFEATURE", 0, 0, 0, True, 0, Nothing, 0)
137     swModel.FeatureManager.PreTrimSurface(0, 1, 0, 0)
138     swModel.Extension.SelectByID2("", "SURFACEBODY", xyz(0), xyz(1), xyz(2), True, 0, Nothing, 0) '-0.04387817789132, -0.03087621363591, -0.02079408480836, True, 0, Nothing, 0)
139     swModel.FeatureManager.PostTrimSurface(1)
140     End If
141    
142    
143     '' on coupe l'autre surface
144     swModel.ClearSelection2(True)
145     If PointAGarder(Me.sFaceCoque2, Me.sFaceCoque1, xyz) Then
146     Commun.MettreUnPoint(xyz(0), xyz(1), xyz(2))
147     swModel.Extension.SelectByID2("", "BODYFEATURE", 0, 0, 0, True, 0, Nothing, 0)
148     swModel.FeatureManager.PreTrimSurface(0, 1, 0, 0)
149     swModel.Extension.SelectByID2("", "SURFACEBODY", xyz(0), xyz(1), xyz(2), True, 0, Nothing, 0) '-0.04387817789132, -0.03087621363591, -0.02079408480836, True, 0, Nothing, 0)
150     swModel.FeatureManager.PostTrimSurface(1)
151     End If
152    
153    
154     End Sub
155    
156    
157     ''' <summary>
158     ''' Function qui retourne un point qui appartient à la face1 et pas à la face2
159     ''' </summary>
160     ''' <returns></returns>
161     ''' <remarks></remarks>
162     Private Function PointAGarder(ByRef Face1 As SuperFace, ByRef Face2 As SuperFace, ByRef XYZ() As Double) As Boolean
163     Dim u As Double
164     Dim v As Double
165     Dim umin As Double
166     Dim vmin As Double
167     Dim umax As Double
168     Dim vmax As Double
169    
170    
171     Face1.UVMinMax(umin, umax, vmin, vmax)
172     u = umin
173     v = vmin
174     Dim incV As Double = (vmax - vmin) / 100
175     Dim incU As Double = (umax - umin) / 100
176    
177     Do While u <= umax
178     u += incU
179     Do While v < vmax
180     v += incV
181     If Not Face1.Evaluer(u, v, XYZ(0), XYZ(1), XYZ(2)) Then Continue Do
182     If Commun.Distance(Face2, XYZ(0), XYZ(1), XYZ(2)) > 100 * Epsilon Then Return True
183     Loop
184    
185     Loop
186    
187     Return False
188    
189    
190     End Function
191    
192    
193    
194     ''' <summary>
195 bournival 46 ''' Sub qui dessine le sweep à l'endroit d'intersection
196     ''' </summary>
197     ''' <remarks>Je pourrais couper et mettre les faces internes ici, mais je préfère séparer...</remarks>
198     Public Function GénérerSweep(ByRef sketch As SldWorks.Sketch, ByVal rayon As Double) As SldWorks.Body2
199 bournival 40
200 bournival 46 Dim swEnt As SldWorks.Entity
201 bournival 40
202    
203    
204 bournival 46 ' technique du sweep du cercle
205     ' 1 - trace de la ligne d'intersection
206     ' en théorie c'est déjà fait et on a interFF.sketch qui a le sketch d'intersection...
207 bournival 40
208 bournival 46 ' 2- Placer un plan à l'extrémité
209     Dim Plan As SldWorks.RefPlane
210    
211     Dim vSeg As Object 'SldWorks.SketchSegment
212     Dim seg As SldWorks.SketchSegment
213     Dim skPoint As SldWorks.SketchPoint = Nothing
214    
215    
216     vSeg = sketch.GetSketchSegments() : seg = vSeg(0)
217    
218     Select Case seg.GetType ' faut faire attention, si le sketch est fermé, ça peut chier des taque pour séelectionner le point
219 bournival 48 Case swconst.swSketchSegments_e.swSketchLINE
220 bournival 46 Dim skline As SldWorks.SketchLine = seg
221     skPoint = skline.GetStartPoint2()
222    
223 bournival 48 Case swconst.swSketchSegments_e.swSketchARC
224 bournival 46 Dim skarc As SldWorks.SketchArc = seg
225     skPoint = skarc.GetStartPoint2()
226 bournival 48 Case swconst.swSketchSegments_e.swSketchELLIPSE
227 bournival 46 Dim skellipse As SldWorks.SketchEllipse = seg
228     skPoint = skellipse.GetStartPoint2()
229     If skPoint Is Nothing Then
230     ' couper l'ellipse
231     MsgBox("On a pas de startpoint sur cette ellipse")
232     End If
233 bournival 48 Case swconst.swSketchSegments_e.swSketchSPLINE
234 bournival 46 Dim skSpline As SldWorks.SketchSpline = seg
235     Dim vPoints As Object
236     vPoints = skSpline.GetPoints2()
237     skPoint = vPoints(0)
238 bournival 48 Case swconst.swSketchSegments_e.swSketchPARABOLA
239 bournival 46 Dim skPara As SldWorks.SketchParabola = seg
240     skPoint = skPara.GetStartPoint2()
241     Case Else
242     MsgBox(" Là y'a un problème! (case else....)")
243     End Select
244    
245     seg.Select4(False, Nothing)
246     skPoint.Select4(True, Nothing)
247    
248     Plan = swModel.CreatePlanePerCurveAndPassPoint3(True, False) ' le premier true met l'origine sur le point de la courbe, le second false est pour la visualisation.
249    
250     ' 3 - on créé un cercle sur le plan
251     'Dim rayon As Double
252     'Dim sface As SlyFaceCoque = Me.sFaceCoque
253     Dim feat As SldWorks.Feature
254     Dim sketchCercle As SldWorks.Sketch
255    
256     ' rayon = sface.GetEpaisseur
257     swEnt = Plan : swEnt.Select4(False, Nothing)
258    
259     swModel.InsertSketch2(False)
260     swModel.CreateCircleByRadius2(0, 0, 0, rayon)
261     swModel.InsertSketch2(True)
262    
263     feat = swModel.FeatureByPositionReverse(0)
264     sketchCercle = feat.GetSpecificFeature2()
265    
266     ' 4 - Sweep
267     Dim swFeatManager As SldWorks.FeatureManager = swModel.FeatureManager
268    
269     Dim merge As Boolean = False
270    
271     swEnt = sketchCercle : swEnt.Select2(False, 1)
272     swEnt = sketch : swEnt.Select2(True, 4)
273    
274     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.
275    
276     If feat Is Nothing Then
277     swEnt = sketchCercle : swEnt.Select2(False, 1)
278     swEnt = sketch : swEnt.Select2(True, 4)
279     feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, 0, 0, False, 0, 0, 0, 0, 0, 1, 1, 0, 1)
280     End If
281    
282     If feat Is Nothing Then
283     ' il est possible que la coque soit une spline
284     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!")
285     ' on pourrait éventuellement appliquer une autre méthode.
286     Return Nothing
287     End If
288    
289     Dim vfaces As Object = feat.GetFaces
290     Dim swface As SldWorks.Face2 = vfaces(0)
291     Me.BodySweep = swface.GetBody
292    
293    
294     If Me.BodySweep Is Nothing Then MsgBox(feat.Name)
295     Return Me.BodySweep
296    
297     End Function
298    
299     ''' <summary>
300     '''
301     ''' </summary>
302     ''' <param name="LaCoque"></param>
303     ''' <param name="sweep"></param>
304     ''' <remarks></remarks>
305     Public Sub DecouperCoque(ByRef LaCoque As SlyFaceCoque, ByRef sweep As SldWorks.Body2)
306     If Me.BodySweep Is Nothing Then Exit Sub
307    
308    
309     ' on a un sketch avec 2 ou plusieurs segments à l'intérieur
310     ' et si je sélectionnais un segment à la fois et partait un sketch3d, puis je convertis ce segment et construit ce nouveau sketch...
311     Dim vseg As Object = Me.sketch.GetSketchSegments
312     Dim PetitSketch As SldWorks.Sketch = Nothing
313     Dim swSketchManager As SldWorks.SketchManager = swModel.SketchManager
314     'Dim lstFeat As New Collections.Generic.List(Of SldWorks.Feature)
315     Dim swFace As SldWorks.Face2 = Me.BodySweep.GetFirstFace()
316     Dim swent As SldWorks.Entity
317     Dim featmanager As SldWorks.FeatureManager
318     Dim swface2 As SldWorks.Face2
319     Dim LautreCoque As SlyFaceCoque
320     LautreCoque = IIf(LaCoque Is Me.sFaceCoque1, Me.sFaceCoque2, Me.sFaceCoque1)
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    
337     ' 2 - Couper la coque à partir su sweep
338     swModel.EditRebuild3()
339     featmanager = swModel.FeatureManager
340     Dim faces() As SldWorks.Face2 = LaCoque.GetFaces ' les faces de la coque qui sont découpées
341     For Each swface2 In faces ' les faces de la coque
342     If swModel.ClosestDistance(swface2, sweep, Nothing, Nothing) < Epsilon Then
343     swModel.ClearSelection2(True)
344     swFace = sweep.GetFirstFace()
345     Do While swFace IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
346     swent = swFace : swent.Select2(True, 16)
347     swFace = swFace.GetNextFace
348     Loop
349     LautreCoque.SelectionnerToutes(16, True)
350    
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     sweep.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     LaCoque.AjouterFace(swFace)
363     Next
364    
365     Next
366     End Sub
367    
368    
369     ''' <summary>
370     ''' Sub qui met les attributs de faces internes sur les bonnes faces.
371     ''' </summary>
372     ''' <remarks></remarks>
373     Public Sub MarquerFacesInternes(ByRef CoqueCoupante As SlyFaceCoque, ByRef CoqueCoupee As SlyFaceCoque)
374     ' bon, là il faut trouver les faces internes... mais: la liste de faces dans la slyface
375     'mais j'ai maintenant un moyen de comparer les arètes.
376     Dim trouve As Boolean = False
377     ' 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!!!
378     Dim swFaces() As SldWorks.Face2 = CoqueCoupee.GetFaces
379     Dim swAreteCoques() As SldWorks.Edge = CoqueCoupante.GetAretes
380    
381     For Each face As SldWorks.Face2 In swFaces
382     Dim sFace As New SuperFace(face, True)
383     Dim swAreteVols() As SldWorks.Edge = sFace.GetAretes
384     For Each swAreteVol As SldWorks.Edge In swAreteVols
385     Dim e As New SuperArete(swAreteVol, True) : e.Colorer(2, 0, 1, 0)
386     For Each swAreteCoque As SldWorks.Edge In swAreteCoques
387     If e.comparer(swAreteCoque) Then
388 bournival 130 sFace.MettreAttributFaceInterne(sFace.SwFace, , False)
389 bournival 46 trouve = True : Exit For
390     End If
391     Next
392     If trouve Then trouve = False : Exit For ' on arete de gosser
393     Next
394     Next
395    
396    
397     End Sub
398    
399    
400 bournival 130
401 bournival 40 End Class