ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterCoqueVolume.vb
(Generate patch)

Comparing magicsld/InterCoqueVolume.vb (file contents):
Revision 50 by bournival, Fri Aug 24 21:19:38 2007 UTC vs.
Revision 130 by bournival, Wed Jul 30 21:26:03 2008 UTC

# Line 17 | Line 17 | Public Class InterCoqueVolume
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 Sub QuelleAreteCoqueToucheVolume(Optional ByVal GuideSweep As Boolean = False)
36 <        Dim aretes() As SldWorks.Edge
37 <        Dim Sommet1 As SldWorks.Vertex
38 <        Dim sommet2 As SldWorks.Vertex
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
46 >        Dim swFaceVol() As sldworks.Face2 = Me.sFaceVolume.GetFaces
47 >
48  
49 +        For Each swFaceV As sldworks.Face2 In swFaceVol
50  
39        For Each swFaceV As SldWorks.Face2 In swFaceVol
51              For z = 0 To UBound(aretes)
52                  Sommet1 = aretes(z).GetStartVertex()
53 <                If Sommet1 Is Nothing Then ' on a un cercle...
54 <                    Dim params As Object
55 <                    params = aretes(z).Evaluate(0.5) ' 0.5 pour ne pas être à 0, ni 1, ni 3.14.  Pour être très méticuleur il faudrait vérifier 2 points...
56 <                    If Distance(swFaceV, params(0), params(1), params(2)) < Epsilon Then AreteCoque = aretes(z) : Exit Sub
57 <                Else
58 <                    sommet2 = aretes(z).GetEndVertex()
59 <                    If Commun.Distance(swFaceV, Sommet1) < Epsilon AndAlso Distance(swFaceV, sommet2) < Epsilon Then
60 <                        If GuideSweep Then ' on doit EN PLUS vérifier que le sweep touche à la courbe
61 <                            If swModel.ClosestDistance(Me.BodySweep, Sommet1, Nothing, Nothing) < Epsilon AndAlso swModel.ClosestDistance(Me.BodySweep, sommet2, Nothing, Nothing) < Epsilon Then AreteCoque = aretes(z) : Exit Sub
62 <                        Else ' ok automatiquement
63 <                            AreteCoque = aretes(z)
64 <                            Exit Sub
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
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)
114 >        'MsgBox("la bonne arète n'a pas été trouvée" & vbCr & eArete.ToString)
115  
116  
117 <    End Sub
117 >    End Function
118  
119  
120      ''' <summary>
121      ''' Sub qui dessine le sweep à l'endroit d'intersection
122      ''' </summary>
123 <    ''' <remarks>Je pourrais couper et mettre les faces internes ici, mais je préfère séparer...</remarks>
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...
# Line 96 | Line 128 | Public Class InterCoqueVolume
128  
129          If sketch Is Nothing Then
130              If Me.AreteCoque Is Nothing Then Me.QuelleAreteCoqueToucheVolume()
99
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)
# Line 166 | Line 197 | Public Class InterCoqueVolume
197          swEnt = Plan : swEnt.Select4(False, Nothing)
198  
199          swModel.InsertSketch2(False)
200 <        swModel.CreateCircleByRadius2(0, 0, 0, rayon)
200 >        swModel.CreateCircleByRadius2(0, 0, 0, rayon / 2)
201          swModel.InsertSketch2(True)
202  
203          feat = swModel.FeatureByPositionReverse(0)
# Line 205 | Line 236 | Public Class InterCoqueVolume
236      End Sub
237  
238  
208
239      ''' <summary>
240 <    ''' 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.
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>Utile pour les intersections coque-volume seulement (pour l'instant)</remarks>
244 <    Public Sub DécouperVolume()
214 <        If Me.BodySweep Is Nothing Then Exit Sub
243 >    ''' <remarks></remarks>
244 >    Private Sub MultiDecoupage()
245  
246 <        ' sélectionner toutes les faces du sweep avec un mark de 16
247 <        Dim swFace As SldWorks.Face2 = Me.BodySweep.GetFirstFace()
248 <        Dim swent As SldWorks.Entity
249 <        Dim featmanager As SldWorks.FeatureManager
250 <        Dim feat As SldWorks.Feature = Nothing
251 <        Dim faces() As SldWorks.Face2
252 <        Dim sface As SlyFaceVolume = Me.sFaceVolume  ' la face du volume
253 <        Dim swface2 As SldWorks.Face2
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  
226        '  ***** Découpage du volume****
227        swModel.EditRebuild3()
228        featmanager = swModel.FeatureManager
266  
267 <        faces = sface.GetFaces
268 <        Dim scoque As SlyFaceCoque = Me.sFaceCoque
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 <        For Each swface2 In faces
291 <            If swModel.ClosestDistance(swface2, Me.BodySweep, Nothing, Nothing) < Epsilon Then
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 <                swModel.ClearSelection2(True)
305 <                Do While swFace IsNot Nothing  ' les faces coupantes (celles du sweep) ont un mark de 16
306 <                    swent = swFace : swent.Select2(True, 16)
307 <                    swFace = swFace.GetNextFace
241 <                Loop
242 <
243 <                ' sélection de la bonne face de coque:  
244 <                'swent = swfaceCoque : swent.Select2(True, 16)
245 <                Me.SelectionneBonneCoque(True, 16)
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  
247                swent = swface2 : swent.Select2(True, 32)
309  
310 <                feat = featmanager.InsertSplitLineIntersect(7)
311 <                If feat IsNot Nothing Then Exit For
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  
252            End If
253        Next
316  
317 <        Me.BodySweep.HideBody(True)
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 <        ' ajout des nouvelles faces
322 <        Dim vfaces As Object = feat.GetFaces()
259 <        'Dim swFaceBonne As SldWorks.Face2 = Nothing
260 <        'Dim PointTouche(2) As Double ' attention, ce n'est plus un midpoint...
261 <        'Dim eArete As New SuperArete(Me.AreteCoque, True)
262 <        'If Me.PointQuiTouche(0) = -999 Then PointTouche = eArete.GetPointMilieu() Else PointTouche = Me.PointQuiTouche
263 <        ' swModel.ClearSelection2(True)
321 >            '  Dim selMgr As sldworks.SelectionMgr = swModel.SelectionManager
322 >            ' MsgBox(selMgr.GetSelectedObjectCount2(-1) & selMgr.GetSelectedObjectType3(1, -1))
323  
324 <        For Each swFace In vfaces  ' sélectionne les faces découpées.
325 <            sface.AjouterFace(swFace)
326 <        Next
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>
# Line 288 | Line 484 | Public Class InterCoqueVolume
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) > Epsilon Then prendre = False : Continue For
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
# Line 304 | Line 500 | Public Class InterCoqueVolume
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
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
# Line 312 | Line 508 | Public Class InterCoqueVolume
508          Dim vseg As Object = Me.sketch.GetSketchSegments
509          Dim PetitSketch As SldWorks.Sketch = Nothing
510          Dim swSketchManager As SldWorks.SketchManager = swModel.SketchManager
511 <        'Dim lstFeat As New Collections.Generic.List(Of SldWorks.Feature)
512 <        Dim swFace As SldWorks.Face2 = Me.BodySweep.GetFirstFace()
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
# Line 336 | Line 532 | Public Class InterCoqueVolume
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 su sweep
535 >            ' 2 - Couper la coque à partir du sweep
536              swModel.EditRebuild3()
537              featmanager = swModel.FeatureManager
538              Dim faces() As SldWorks.Face2 = scoque.GetFaces
# Line 371 | Line 567 | Public Class InterCoqueVolume
567  
568  
569      ''' <summary>
570 <    ''' Function qui retourne vrai si l'on doit couper la coque
570 >    '''
571      ''' </summary>
572      ''' <returns>Vrai si la coque doit être coupée</returns>
573 <    ''' <remarks></remarks>
574 <    Public Function DoitCouperCoque() As Boolean
575 <        Dim vSeg As Object = Me.sketch.GetSketchSegments()
576 <        If UBound(vSeg) > 0 Then Return True Else Return False
577 <    End Function
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>
# Line 389 | Line 596 | Public Class InterCoqueVolume
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)
609 >                Dim e As New SuperArete(swAreteVol, True) ': e.Colorer(2, 0, 1, 0)
610                  For Each swAreteCoque As sldworks.Edge In swAreteCoques
611 <                    If e.comparer(swAreteCoque) Then
612 <                        sFace.MettreAttributFaceInterne()
613 <                        trouve = True : Exit For
614 <                    End If
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 <                If trouve Then trouve = False : Exit For ' on arete de gosser
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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines