REPOS_ERICCA/magicsld/CLCode.vb

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

Namespace ConditionsAuxLimites
    Module CLCode

        Public AnnoSeul As Boolean
        Public checkbox1 As SldWorks.PropertyManagerPageCheckbox
        Public checkbox2 As SldWorks.PropertyManagerPageCheckbox
        Public selection1 As SldWorks.PropertyManagerPageSelectionbox
        Public combo1 As SldWorks.PropertyManagerPageCombobox
        Public Numberbox1 As SldWorks.PropertyManagerPageNumberbox

        Public DessinerCL As SldWorks.PropertyManagerPageCheckbox

        ''' <summary>
        ''' En théorie obsolète
        ''' </summary>
        ''' <param name="TypeCl"></param>
        ''' <param name="valeur"></param>
        ''' <param name="couleur"></param>
        ''' <param name="balon"></param>
        ''' <remarks></remarks>
        Private Sub MettreNote(ByRef TypeCl As String, ByRef valeur As Double, ByRef couleur As Long, ByVal balon As Integer)
            ' prend toutes les entités sélectionnées et met une annotation dessu.


            Dim Note As SldWorks.Note
            Dim Annotation As SldWorks.Annotation
            Dim TextFormat As Object = Nothing
            Note = swPart.InsertNote(TypeCl & "," & valeur)
            If Not Note Is Nothing Then
                Note.Angle = 0
                Note.SetBalloon(balon, 0)
                Annotation = Note.GetAnnotation()
                If Not Annotation Is Nothing Then
                    Annotation.SetLeader2(True, 0, True, True, False, False)
                    Annotation.SetPosition(0, 0, 0) ' coordonnées à évaluer
                    Annotation.SetTextFormat(0, True, TextFormat)
                End If

            End If
            swPart.ClearSelection2(True)

        End Sub


        'Private Function addCaL(ByRef nom As String, ByRef cl As CaL) As String
        '    ' cette fonction prend un nom et ajoute une condition aux limites au nom.
        '    ' seul le nom est modidifié
        '    ' on a un nom, s'il n'a pas encore de conditions aux limites alors on doit ajouter un dièse et 01.
        '    Dim i As Integer
        '    Dim nb As Integer
        '    Dim c As Integer

        '    For i = 1 To Len(nom)
        '        If Mid(nom, i, 1) = "@" Then
        '            nb = Val(Mid(nom, i + 1, 2)) + 1
        '            Mid(nom, i + 1, 2) = Format(nb, "00")
        '            If cl.valeur >= 0 Then ' valeur positive
        '                nom = nom & cl.TypeCL & "+" & Format(cl.valeur, "0.00000e+000")
        '            Else
        '                nom = nom & cl.TypeCL & Format(cl.valeur, "0.00000e+000")
        '            End If

        '            For c = 1 To Len(nom)
        '                If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
        '            Next c
        '            addCaL = nom
        '            Exit Function ' on a fait toutes les modifications
        '        End If
        '    Next i

        '    ' rajouter la première condition aux limites
        '    Dim valeur As String = Nothing
        '    If cl.valeur >= 0 Then valeur = "+" & Format(cl.valeur, "0.00000e+000")
        '    nom = nom & "@01" & cl.TypeCL & valeur
        '    'MsgBox " Première Condition = " & nom

        '    ' remplacer une virgule par un point
        '    For c = 1 To Len(nom)
        '        If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
        '    Next c
        '    addCaL = nom

        'End Function


        Public Sub inclure_sous_jacent() 'ByRef CLPage As SldWorks.PropertyManagerPage2)
            Dim swEnt As SldWorks.Entity
            Dim i As Integer
            Dim SelMgr As SldWorks.SelectionMgr

            SelMgr = swModel.SelectionManager

            For i = 1 To SelMgr.GetSelectedObjectCount
                swEnt = SelMgr.GetSelectedObject5(i)
                Select Case swEnt.GetType
                    Case 2  ' une face
                        Dim swFace As SldWorks.Face2
                        swFace = swEnt
                        SelectSousJacent(swFace)

                    Case 1 ' arete
                        Dim swArete As SldWorks.Edge
                        swArete = swEnt
                        SelectSousJacent(swArete)
                End Select
            Next i
            swModel.GraphicsRedraw()

            'CLPage.Close(False)
            'CLPage.Show()


        End Sub

        Private Sub SelectSousJacent(ByRef swFace As SldWorks.Face2)
            Dim swEnt As SldWorks.Entity
            Dim coa As Integer
            Dim swLoop As SldWorks.Loop2
            Dim swCoArete As SldWorks.CoEdge
            Dim swArete As SldWorks.Edge

            swLoop = swFace.GetFirstLoop
            Do While Not swLoop Is Nothing
                swCoArete = swLoop.GetFirstCoEdge
                For coa = 0 To swLoop.GetEdgeCount
                    swArete = swCoArete.GetEdge

                    swEnt = swArete
                    swEnt.Select4(True, Nothing)


                    Call SelectSousJacent(swArete)

                    swCoArete = swCoArete.GetNext
                Next coa ' fin de loop sur les coaretes

                swLoop = swLoop.GetNext
            Loop ' fin loop sur loop

        End Sub

        Private Sub SelectSousJacent(ByRef swArete As SldWorks.Edge)
            ' l'arête est sélectionnée, il faut sélectionner ses sommets...
            Dim sommet1 As SldWorks.Vertex
            Dim sommet2 As SldWorks.Vertex
            Dim swEnt As SldWorks.Entity

            sommet1 = swArete.GetStartVertex

            If IsNothing(sommet1) Then Exit Sub ' courbe sans sommets

            swEnt = sommet1
            swEnt.Select4(True, Nothing)

            sommet2 = swArete.GetEndVertex
            swEnt = sommet2
            swEnt.Select4(True, Nothing)

        End Sub


        ''' <summary>
        ''' Sub qui prend les informations de la page de propriétés et qui en fait des conditions aux limites
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub enregistrer_CL()
            Dim CL As EncapCL = Nothing
            Dim tipe As String
            Dim valeur As Double
            Dim selMgr As SldWorks.SelectionMgr
            Dim i As Integer
            Dim swEnt As SldWorks.Entity
            Dim n As Integer

            tipe = Left(combo1.ItemText(combo1.CurrentSelection), 2)
            valeur = Numberbox1.Value

            Dim listeentite As New Collections.Generic.List(Of SldWorks.Entity)
            Dim lstpoints() As Double = Nothing
            selMgr = swModel.SelectionManager

            For i = 1 To selMgr.GetSelectedObjectCount
                If selMgr.GetSelectedObjectType2(i) = swconst.swSelectType_e.swSelPOINTREFS Then
                    ' transformer la sélection d'un pointref en une sélection de vertex
                    Dim coords(2) As Double
                    Dim vretval As Object
                    vretval = selMgr.GetSelectionPoint(i)
                    coords = vretval

                    If lstpoints Is Nothing Then n = 0 Else n = UBound(lstpoints)
                    ReDim lstpoints(n + 3)
                    lstpoints(n + 0) = coords(0)
                    lstpoints(n + 1) = coords(1)
                    lstpoints(n + 2) = coords(2)

                Else
                    listeentite.Add(selMgr.GetSelectedObject5(i))
                End If
            Next i

            If lstpoints IsNot Nothing Then
                For j As Integer = 0 To lstpoints.GetUpperBound(0) Step 3
                    If Not swModel.AndSelectByID(Nothing, "VERTEX", lstpoints(j + 0), lstpoints(j + 1), lstpoints(j + 2)) Then MsgBox("Échec")
                    Dim swsommet As SldWorks.Vertex

                    swModel.SelectAt(swconst.swSelectType_e.swSelVERTICES, lstpoints(j + 0), lstpoints(j + 1), lstpoints(j + 2))
                    swEnt = selMgr.GetSelectedObject5(1)
                    swsommet = swEnt

                    CL = New EncapCL(swsommet)
                    CL.AjouterCondition(tipe, valeur, IIf(CLCode.DessinerCL.Checked, True, False))
                Next
            End If


            For Each swEnt In listeentite
                If swEnt IsNot Nothing Then
retour:
                    Select Case swEnt.GetType
                        Case swconst.swSelectType_e.swSelVERTICES
                            Dim swSommet As SldWorks.Vertex
                            swSommet = swEnt
                            CL = New EncapCL(swSommet)

                        Case swconst.swSelectType_e.swSelEDGES
                            Dim swArete As SldWorks.Edge
                            swArete = swEnt
                            CL = New EncapCL(swArete)

                        Case swconst.swSelectType_e.swSelFACES
                            Dim swFace As SldWorks.Face2
                            swFace = swEnt
                            CL = New EncapCL(swFace)
                        Case swconst.swSelectType_e.swSelATTRIBUTES
                            Dim attr As SldWorks.Attribute = swEnt
                            swEnt = attr.GetEntity2()
                            GoTo retour
                        Case Else
                            'MsgBox("Une entité sélectionnée ne peut avoir de condition aux limites -->" & selMgr.GetSelectedObjectType2(i))

                    End Select
                    CL.AjouterCondition(tipe, valeur, IIf(CLCode.DessinerCL.Checked, True, False))
                End If

            Next swEnt
        End Sub

    End Module
End Namespace
Revision:	48
Committed:	Wed Aug 22 21:18:12 2007 UTC (17 years, 8 months ago) by bournival
File size:	9867 byte(s)
Log Message:	On passe aux nouveaux .dll
#	User	Rev	Content
1	bournival	48	Imports SolidWorks.Interop
2			Imports SolidWorks.Interop.swconst
3			Imports SolidWorks.Interop.swpublished
4
5	bournival	40	Namespace ConditionsAuxLimites
6			Module CLCode
7
8			Public AnnoSeul As Boolean
9			Public checkbox1 As SldWorks.PropertyManagerPageCheckbox
10			Public checkbox2 As SldWorks.PropertyManagerPageCheckbox
11			Public selection1 As SldWorks.PropertyManagerPageSelectionbox
12			Public combo1 As SldWorks.PropertyManagerPageCombobox
13			Public Numberbox1 As SldWorks.PropertyManagerPageNumberbox
14
15			Public DessinerCL As SldWorks.PropertyManagerPageCheckbox
16
17			''' <summary>
18			''' En théorie obsolète
19			''' </summary>
20			''' <param name="TypeCl"></param>
21			''' <param name="valeur"></param>
22			''' <param name="couleur"></param>
23			''' <param name="balon"></param>
24			''' <remarks></remarks>
25			Private Sub MettreNote(ByRef TypeCl As String, ByRef valeur As Double, ByRef couleur As Long, ByVal balon As Integer)
26			' prend toutes les entités sélectionnées et met une annotation dessu.
27
28
29			Dim Note As SldWorks.Note
30			Dim Annotation As SldWorks.Annotation
31	bournival	48	Dim TextFormat As Object = Nothing
32	bournival	40	Note = swPart.InsertNote(TypeCl & "," & valeur)
33			If Not Note Is Nothing Then
34			Note.Angle = 0
35			Note.SetBalloon(balon, 0)
36			Annotation = Note.GetAnnotation()
37			If Not Annotation Is Nothing Then
38			Annotation.SetLeader2(True, 0, True, True, False, False)
39			Annotation.SetPosition(0, 0, 0) ' coordonnées à évaluer
40			Annotation.SetTextFormat(0, True, TextFormat)
41			End If
42
43			End If
44			swPart.ClearSelection2(True)
45
46			End Sub
47
48
49
50			'Private Function addCaL(ByRef nom As String, ByRef cl As CaL) As String
51			' ' cette fonction prend un nom et ajoute une condition aux limites au nom.
52			' ' seul le nom est modidifié
53			' ' on a un nom, s'il n'a pas encore de conditions aux limites alors on doit ajouter un dièse et 01.
54			' Dim i As Integer
55			' Dim nb As Integer
56			' Dim c As Integer
57
58			' For i = 1 To Len(nom)
59			' If Mid(nom, i, 1) = "@" Then
60			' nb = Val(Mid(nom, i + 1, 2)) + 1
61			' Mid(nom, i + 1, 2) = Format(nb, "00")
62			' If cl.valeur >= 0 Then ' valeur positive
63			' nom = nom & cl.TypeCL & "+" & Format(cl.valeur, "0.00000e+000")
64			' Else
65			' nom = nom & cl.TypeCL & Format(cl.valeur, "0.00000e+000")
66			' End If
67
68			' For c = 1 To Len(nom)
69			' If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
70			' Next c
71			' addCaL = nom
72			' Exit Function ' on a fait toutes les modifications
73			' End If
74			' Next i
75
76			' ' rajouter la première condition aux limites
77			' Dim valeur As String = Nothing
78			' If cl.valeur >= 0 Then valeur = "+" & Format(cl.valeur, "0.00000e+000")
79			' nom = nom & "@01" & cl.TypeCL & valeur
80			' 'MsgBox " Première Condition = " & nom
81
82			' ' remplacer une virgule par un point
83			' For c = 1 To Len(nom)
84			' If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
85			' Next c
86			' addCaL = nom
87
88			'End Function
89
90
91			Public Sub inclure_sous_jacent() 'ByRef CLPage As SldWorks.PropertyManagerPage2)
92			Dim swEnt As SldWorks.Entity
93			Dim i As Integer
94			Dim SelMgr As SldWorks.SelectionMgr
95
96			SelMgr = swModel.SelectionManager
97
98			For i = 1 To SelMgr.GetSelectedObjectCount
99			swEnt = SelMgr.GetSelectedObject5(i)
100			Select Case swEnt.GetType
101			Case 2 ' une face
102			Dim swFace As SldWorks.Face2
103			swFace = swEnt
104			SelectSousJacent(swFace)
105
106			Case 1 ' arete
107			Dim swArete As SldWorks.Edge
108			swArete = swEnt
109			SelectSousJacent(swArete)
110			End Select
111			Next i
112			swModel.GraphicsRedraw()
113
114			'CLPage.Close(False)
115			'CLPage.Show()
116
117
118			End Sub
119
120			Private Sub SelectSousJacent(ByRef swFace As SldWorks.Face2)
121			Dim swEnt As SldWorks.Entity
122			Dim coa As Integer
123			Dim swLoop As SldWorks.Loop2
124			Dim swCoArete As SldWorks.CoEdge
125			Dim swArete As SldWorks.Edge
126
127			swLoop = swFace.GetFirstLoop
128			Do While Not swLoop Is Nothing
129			swCoArete = swLoop.GetFirstCoEdge
130			For coa = 0 To swLoop.GetEdgeCount
131			swArete = swCoArete.GetEdge
132
133			swEnt = swArete
134			swEnt.Select4(True, Nothing)
135
136
137			Call SelectSousJacent(swArete)
138
139			swCoArete = swCoArete.GetNext
140			Next coa ' fin de loop sur les coaretes
141
142			swLoop = swLoop.GetNext
143			Loop ' fin loop sur loop
144
145			End Sub
146
147			Private Sub SelectSousJacent(ByRef swArete As SldWorks.Edge)
148			' l'arête est sélectionnée, il faut sélectionner ses sommets...
149			Dim sommet1 As SldWorks.Vertex
150			Dim sommet2 As SldWorks.Vertex
151			Dim swEnt As SldWorks.Entity
152
153			sommet1 = swArete.GetStartVertex
154
155			If IsNothing(sommet1) Then Exit Sub ' courbe sans sommets
156
157			swEnt = sommet1
158			swEnt.Select4(True, Nothing)
159
160			sommet2 = swArete.GetEndVertex
161			swEnt = sommet2
162			swEnt.Select4(True, Nothing)
163
164			End Sub
165
166
167			''' <summary>
168			''' Sub qui prend les informations de la page de propriétés et qui en fait des conditions aux limites
169			''' </summary>
170			''' <remarks></remarks>
171			Public Sub enregistrer_CL()
172			Dim CL As EncapCL = Nothing
173			Dim tipe As String
174			Dim valeur As Double
175			Dim selMgr As SldWorks.SelectionMgr
176			Dim i As Integer
177			Dim swEnt As SldWorks.Entity
178			Dim n As Integer
179
180			tipe = Left(combo1.ItemText(combo1.CurrentSelection), 2)
181			valeur = Numberbox1.Value
182
183			Dim listeentite As New Collections.Generic.List(Of SldWorks.Entity)
184			Dim lstpoints() As Double = Nothing
185			selMgr = swModel.SelectionManager
186
187			For i = 1 To selMgr.GetSelectedObjectCount
188	bournival	48	If selMgr.GetSelectedObjectType2(i) = swconst.swSelectType_e.swSelPOINTREFS Then
189	bournival	40	' transformer la sélection d'un pointref en une sélection de vertex
190			Dim coords(2) As Double
191			Dim vretval As Object
192			vretval = selMgr.GetSelectionPoint(i)
193			coords = vretval
194
195			If lstpoints Is Nothing Then n = 0 Else n = UBound(lstpoints)
196			ReDim lstpoints(n + 3)
197			lstpoints(n + 0) = coords(0)
198			lstpoints(n + 1) = coords(1)
199			lstpoints(n + 2) = coords(2)
200
201			Else
202			listeentite.Add(selMgr.GetSelectedObject5(i))
203			End If
204			Next i
205
206			If lstpoints IsNot Nothing Then
207			For j As Integer = 0 To lstpoints.GetUpperBound(0) Step 3
208			If Not swModel.AndSelectByID(Nothing, "VERTEX", lstpoints(j + 0), lstpoints(j + 1), lstpoints(j + 2)) Then MsgBox("Échec")
209			Dim swsommet As SldWorks.Vertex
210
211	bournival	48	swModel.SelectAt(swconst.swSelectType_e.swSelVERTICES, lstpoints(j + 0), lstpoints(j + 1), lstpoints(j + 2))
212	bournival	40	swEnt = selMgr.GetSelectedObject5(1)
213			swsommet = swEnt
214
215			CL = New EncapCL(swsommet)
216			CL.AjouterCondition(tipe, valeur, IIf(CLCode.DessinerCL.Checked, True, False))
217			Next
218			End If
219
220
221
222
223			For Each swEnt In listeentite
224			If swEnt IsNot Nothing Then
225	bournival	46	retour:
226	bournival	40	Select Case swEnt.GetType
227	bournival	48	Case swconst.swSelectType_e.swSelVERTICES
228	bournival	40	Dim swSommet As SldWorks.Vertex
229			swSommet = swEnt
230			CL = New EncapCL(swSommet)
231
232	bournival	48	Case swconst.swSelectType_e.swSelEDGES
233	bournival	40	Dim swArete As SldWorks.Edge
234			swArete = swEnt
235			CL = New EncapCL(swArete)
236
237	bournival	48	Case swconst.swSelectType_e.swSelFACES
238	bournival	40	Dim swFace As SldWorks.Face2
239			swFace = swEnt
240			CL = New EncapCL(swFace)
241	bournival	48	Case swconst.swSelectType_e.swSelATTRIBUTES
242	bournival	46	Dim attr As SldWorks.Attribute = swEnt
243			swEnt = attr.GetEntity2()
244			GoTo retour
245	bournival	40	Case Else
246			'MsgBox("Une entité sélectionnée ne peut avoir de condition aux limites -->" & selMgr.GetSelectedObjectType2(i))
247
248			End Select
249			CL.AjouterCondition(tipe, valeur, IIf(CLCode.DessinerCL.Checked, True, False))
250			End If
251
252			Next swEnt
253			End Sub
254
255	bournival	48	End Module
256	bournival	40	End Namespace