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.
#	Content
1	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	retour:
222	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	Case SwConst.swSelectType_e.swSelATTRIBUTES
238	Dim attr As SldWorks.Attribute = swEnt
239	swEnt = attr.GetEntity2()
240	GoTo retour
241	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