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 Overloads Sub SelectSousJacent(ByRef swFace As sldworks.Face2)
            Dim swEnt As sldworks.Entity
            Dim coa As Integer
            Dim swLoop As sldworks.Loop2

            swLoop = swFace.GetFirstLoop
            Do While Not swLoop Is Nothing

                Dim vArete As Object = swLoop.GetEdges()
                For Each swArete As sldworks.Edge In vArete
                    'swEnt = swArete
                    'swEnt.Select3(True, 0, Nothing)
                    Dim e As New SuperArete(swArete, True) : e.SelectionnerSafe()
                    Call SelectSousJacent(swArete)
                Next swArete ' fin de loop sur les coaretes

                swLoop = swLoop.GetNext
            Loop ' fin loop sur loop

        End Sub

        Private Overloads 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.Select2(True, Nothing)
            Dim esom1 As New SuperSommet(sommet1, True) : esom1.SelectionnerSafe()

            sommet2 = swArete.GetEndVertex
            'swEnt = sommet2
            'swEnt.Select2(True, Nothing)
            Dim esom2 As New SuperSommet(sommet2, True) : esom2.SelectionnerSafe()

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