REPOS_ERICCA/magicsld/CLCode.vb

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