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

# 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 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 ''' 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
200 Dim swEnt As SldWorks.Entity
201
202
203
204 ' 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
208 ' 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 Case swconst.swSketchSegments_e.swSketchLINE
220 Dim skline As SldWorks.SketchLine = seg
221 skPoint = skline.GetStartPoint2()
222
223 Case swconst.swSketchSegments_e.swSketchARC
224 Dim skarc As SldWorks.SketchArc = seg
225 skPoint = skarc.GetStartPoint2()
226 Case swconst.swSketchSegments_e.swSketchELLIPSE
227 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 Case swconst.swSketchSegments_e.swSketchSPLINE
234 Dim skSpline As SldWorks.SketchSpline = seg
235 Dim vPoints As Object
236 vPoints = skSpline.GetPoints2()
237 skPoint = vPoints(0)
238 Case swconst.swSketchSegments_e.swSketchPARABOLA
239 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 sFace.MettreAttributFaceInterne(sFace.SwFace, , False)
389 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
401 End Class