REPOS_ERICCA/magicsld/InterPoutreVolume.vb

Imports SolidWorks.Interop
Imports SolidWorks.Interop.swconst
Imports SolidWorks.Interop.swpublished

Public Class InterPoutreVolume
    Inherits InterAreteFace

    'Public sFaceVolume As SlyFaceVolume
    'Private BodySweep As sldworks.Body2


    Public Sub New()

    End Sub


    Public Overrides Sub DecouperLong()
        MyBase.DecouperLong()
        ' on peut avoir une liste de poutres...
        'For Each poutre As SlyAretePoutre In Me.lst_sPoutre
        Dim poutre As SlyAretePoutre = Me.lst_sPoutre.Item(1)

        Dim PetitSketch As sldworks.Sketch = Nothing
        Dim swSketchManager As sldworks.SketchManager = swModel.SketchManager
        Dim sfaceVol As SlyFaceVolume   ' la face du volume
        Dim swfaceVol As sldworks.Face2

        Dim segment As sldworks.Entity = poutre.swArete

        swModel.ClearSelection()
        If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
        swModel.Insert3DSketch2(False)
        segment.Select4(False, Nothing)
        swSketchManager.SketchUseEdge(False)
        swModel.Insert3DSketch2(False)
        swModel.EditRebuild3()

        Dim feat As sldworks.Feature = swModel.FeatureByPositionReverse(0)
        If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
        PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch

        ' 1 - créer le sweep à partir du sketch
        Me.GénérerSweep(PetitSketch) ' hahahaha on réutilise la sub !!

        ' sélectionner toutes les faces du sweep avec un mark de 16
        Dim swFaceSweep As sldworks.Face2 = Me.BodySweep.GetFirstFace()
        Dim swent As sldworks.Entity
        Dim featmanager As sldworks.FeatureManager
        Dim faces() As sldworks.Face2


        '  ***** Découpage du volume****
        swModel.EditRebuild3()
        featmanager = swModel.FeatureManager
        feat = Nothing


        sfaceVol = Me.sFaceVolume


        faces = sfaceVol.GetFaces


        For q As Integer = 0 To UBound(faces)
            swfaceVol = faces(q)
            ' 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.
            If swModel.ClosestDistance(swfaceVol, Me.BodySweep, Nothing, Nothing) < Epsilon Then

                swModel.ClearSelection2(True)
                Do While swFaceSweep IsNot Nothing  ' les faces coupantes (celles du sweep) ont un mark de 16
                    swent = swFaceSweep : swent.Select2(True, 16)
                    swFaceSweep = swFaceSweep.GetNextFace
                Loop

                swent = swfaceVol : swent.Select2(True, 32)
                feat = featmanager.InsertSplitLineIntersect(7)
                If feat IsNot Nothing Then Exit For

            End If
        Next

        If feat Is Nothing Then
            If swApp.SendMsgToUser2("Solidworks est incapable de découper la face du volume, entre " & Me.sFaceVolume.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
        End If

        Me.BodySweep.HideBody(True)

        ' ajout des nouvelles faces
        Dim vfaces As Object = feat.GetFaces()
        swModel.EditRebuild3()

        For Each swfaceVol In vfaces  ' sélectionne les faces découpées.
            If Not swfaceVol.GetBody Is Me.BodySweep Then
                sfaceVol.AjouterFace(swfaceVol)
                'là on a une connerie, la face originale n'est pas dans la liste des faces de vFaces 
                'et le pointeur original semble détruit
                ' puisque ajouterface ne créé pas de doubles, on va chercher des faces que l'on mettra dans la liste 
                ' la grosse face en fera automatiquement partie.
                Dim obj As Object = swfaceVol.GetEdges
                Dim aretes As sldworks.Edge = obj(0)
                Dim oBjfaces As Object = aretes.GetTwoAdjacentFaces2()
                Dim NewFaces As sldworks.Face2 = oBjfaces(0)
                sfaceVol.AjouterFace(NewFaces)
                NewFaces = oBjfaces(1)
                sfaceVol.AjouterFace(NewFaces)
                aretes = obj(1)
                NewFaces = oBjfaces(0)
                sfaceVol.AjouterFace(NewFaces)
                NewFaces = oBjfaces(1)
                sfaceVol.AjouterFace(NewFaces)
            End If
        Next

        ' il faut trouver les faces internes et les tagger comme des faces de coque(pour les mini-poutres orientées)

        'Next poutre
    End Sub


End Class
Revision:	205
Committed:	Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size:	4759 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
#	User	Rev	Content
1	bournival	130	Imports SolidWorks.Interop
2			Imports SolidWorks.Interop.swconst
3			Imports SolidWorks.Interop.swpublished
4
5			Public Class InterPoutreVolume
6			Inherits InterAreteFace
7
8			'Public sFaceVolume As SlyFaceVolume
9			'Private BodySweep As sldworks.Body2
10
11
12	bournival	205	Public Sub New()
13	bournival	130
14			End Sub
15
16
17	bournival	205	Public Overrides Sub DecouperLong()
18			MyBase.DecouperLong()
19			' on peut avoir une liste de poutres...
20			'For Each poutre As SlyAretePoutre In Me.lst_sPoutre
21			Dim poutre As SlyAretePoutre = Me.lst_sPoutre.Item(1)
22	bournival	130
23	bournival	205	Dim PetitSketch As sldworks.Sketch = Nothing
24			Dim swSketchManager As sldworks.SketchManager = swModel.SketchManager
25			Dim sfaceVol As SlyFaceVolume ' la face du volume
26			Dim swfaceVol As sldworks.Face2
27	bournival	130
28	bournival	205	Dim segment As sldworks.Entity = poutre.swArete
29	bournival	130
30	bournival	205	swModel.ClearSelection()
31			If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
32			swModel.Insert3DSketch2(False)
33			segment.Select4(False, Nothing)
34			swSketchManager.SketchUseEdge(False)
35			swModel.Insert3DSketch2(False)
36			swModel.EditRebuild3()
37	bournival	130
38	bournival	205	Dim feat As sldworks.Feature = swModel.FeatureByPositionReverse(0)
39			If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
40			PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
41	bournival	130
42	bournival	205	' 1 - créer le sweep à partir du sketch
43			Me.GénérerSweep(PetitSketch) ' hahahaha on réutilise la sub !!
44	bournival	130
45	bournival	205	' sélectionner toutes les faces du sweep avec un mark de 16
46			Dim swFaceSweep As sldworks.Face2 = Me.BodySweep.GetFirstFace()
47			Dim swent As sldworks.Entity
48			Dim featmanager As sldworks.FeatureManager
49			Dim faces() As sldworks.Face2
50	bournival	130
51
52	bournival	205	' *** Découpage du volume**
53			swModel.EditRebuild3()
54			featmanager = swModel.FeatureManager
55			feat = Nothing
56	bournival	130
57
58	bournival	205	sfaceVol = Me.sFaceVolume
59	bournival	130
60
61	bournival	205	faces = sfaceVol.GetFaces
62	bournival	130
63
64	bournival	205	For q As Integer = 0 To UBound(faces)
65			swfaceVol = faces(q)
66			' 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.
67			If swModel.ClosestDistance(swfaceVol, Me.BodySweep, Nothing, Nothing) < Epsilon Then
68	bournival	130
69	bournival	205	swModel.ClearSelection2(True)
70			Do While swFaceSweep IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
71			swent = swFaceSweep : swent.Select2(True, 16)
72			swFaceSweep = swFaceSweep.GetNextFace
73			Loop
74	bournival	130
75	bournival	205	swent = swfaceVol : swent.Select2(True, 32)
76			feat = featmanager.InsertSplitLineIntersect(7)
77			If feat IsNot Nothing Then Exit For
78	bournival	130
79	bournival	205	End If
80			Next
81	bournival	130
82	bournival	205	If feat Is Nothing Then
83			If swApp.SendMsgToUser2("Solidworks est incapable de découper la face du volume, entre " & Me.sFaceVolume.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
84			End If
85	bournival	130
86	bournival	205	Me.BodySweep.HideBody(True)
87	bournival	130
88	bournival	205	' ajout des nouvelles faces
89			Dim vfaces As Object = feat.GetFaces()
90			swModel.EditRebuild3()
91	bournival	130
92	bournival	205	For Each swfaceVol In vfaces ' sélectionne les faces découpées.
93			If Not swfaceVol.GetBody Is Me.BodySweep Then
94			sfaceVol.AjouterFace(swfaceVol)
95			'là on a une connerie, la face originale n'est pas dans la liste des faces de vFaces
96			'et le pointeur original semble détruit
97			' puisque ajouterface ne créé pas de doubles, on va chercher des faces que l'on mettra dans la liste
98			' la grosse face en fera automatiquement partie.
99			Dim obj As Object = swfaceVol.GetEdges
100			Dim aretes As sldworks.Edge = obj(0)
101			Dim oBjfaces As Object = aretes.GetTwoAdjacentFaces2()
102			Dim NewFaces As sldworks.Face2 = oBjfaces(0)
103			sfaceVol.AjouterFace(NewFaces)
104			NewFaces = oBjfaces(1)
105			sfaceVol.AjouterFace(NewFaces)
106			aretes = obj(1)
107			NewFaces = oBjfaces(0)
108			sfaceVol.AjouterFace(NewFaces)
109			NewFaces = oBjfaces(1)
110			sfaceVol.AjouterFace(NewFaces)
111			End If
112			Next
113	bournival	130
114	bournival	205	' il faut trouver les faces internes et les tagger comme des faces de coque(pour les mini-poutres orientées)
115	bournival	130
116	bournival	205	'Next poutre
117			End Sub
118	bournival	130
119
120
121			End Class