REPOS_ERICCA/magicsld/SuperSommet.vb

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

Public Class SuperSommet
    Inherits SuperEntite
    Public swSommet As SldWorks.Vertex
    Private Shared compteur As Long
    Private Shared no As Long

    Private Shared effacer As Integer

    Public X As Double
    Public Y As Double
    Public Z As Double

    Public Sub New(ByRef sommet As SldWorks.Vertex, Optional ByVal tip As Integer = 0)
        swSommet = sommet

        Select Case tip
            Case Commun.tipe_e.Volume
                nom = "Sommet" & compteur
            Case Commun.tipe_e.coque
                nom = "SommetCoque" & compteur
            Case Commun.tipe_e.poutre
                nom = "SommetPoutre" & compteur
        End Select
        nomOrig = nom
        compteur += 1
    End Sub

    ''' <summary>
    ''' Le new pour un encapsulateur temporaire....
    ''' </summary>
    ''' <param name="Sommet"></param>
    ''' <param name="temporaire">Mettre vrai...</param>
    ''' <remarks></remarks>
    Public Sub New(ByRef Sommet As SldWorks.Vertex, ByRef temporaire As Boolean)
        Dim vpoint As Object
        Me.swSommet = Sommet
        vpoint = swSommet.GetPoint()

        Me.X = vpoint(0)
        Me.Y = vpoint(1)
        Me.Z = vpoint(2)

    End Sub

    Public Overrides Sub SaveNom()
        Dim ent As SldWorks.Entity
        ent = swSommet
        Dim retval As Boolean
        retval = swPart.SetEntityName(ent, nom)
        Dim i As Integer
        If retval = False Then
            Do Until retval = True
                i += 1
                swPart.DeleteEntityName(ent)
                retval = swPart.SetEntityName(ent, nom & Chr(96 + i))
                ent.Select2(False, 0)

                Dim vedge As Object
                Dim edge As SldWorks.Edge
                Dim nom1 As String, nom2 As String
                vedge = swSommet.GetEdges()
                edge = vedge(0) : ent = edge : nom1 = swPart.GetEntityName(ent)
                edge = vedge(1) : ent = edge : nom2 = swPart.GetEntityName(ent)
                If MsgBox("Le sommet " & nom & " a un probl�me pour se s�lectionner." & vbCr & nom1 & vbCr & nom2 & "Quitter?", MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then Err.Raise(555) : Exit Sub

            Loop
        End If

    End Sub

    Shared Sub reinitialiser()
        compteur = 0
    End Sub


    Public Sub MettreAttributPourConditionLimite()
        Dim swent As SldWorks.Entity
        Dim nom As String
        Dim cond As String

        cond = Me.condition
        If cond = "" Then Exit Sub


        swent = Me.swSommet

        nom = "CL" & CStr(no) & "_" & cond
        Dim Attr As SldWorks.Attribute = Nothing

        Try
            Attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe d�j� on pointe dessus.
        Catch ex As Exception
            MsgBox("N'arrive pas � se lier � l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
        End Try

        If Attr Is Nothing Then Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.swSommet, nom, 0, 2) ' 0 = swThisconfig


        While Attr Is Nothing
            no += 1
            nom = "CL" & CStr(no) & "_" & cond
            Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.swSommet, nom, 0, 0)
        End While


        Dim ParamCL As SldWorks.Parameter
        ParamCL = Attr.GetParameter("CL")

        ParamCL.SetStringValue2(cond, 2, "")  ' swAllConfiguration = 2


        GererDossiers("Conditions Aux Limites", nom)
        no = no + 1

    End Sub

    ' une fonction qui transforme un attribut en condition aux limites
    Public Sub AttributVersConditionLimite()
        Dim p As SldWorks.Parameter
        Dim ent As SldWorks.Entity
        Dim attr As SldWorks.Attribute

        ent = Me.swSommet
        attr = ent.FindAttribute(Intersections.DefAttrConditionLimite, 0)
        If Not attr Is Nothing Then
            p = attr.GetParameter("CL")
            nom = nomOrig & "@" & p.GetStringValue
        End If

    End Sub

    Public Overrides Sub Selectionner(Optional ByVal Mark As Integer = 0, Optional ByRef Append As Boolean = True)
        Dim swent As SldWorks.Entity
        swent = swSommet
        swent.Select2(Append, Mark)
    End Sub


    ''' <summary>
    ''' Function qui retourne le pointeur sur le sommet
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function GetSommet() As SldWorks.Vertex
        Return Me.swSommet
    End Function

    ''' <summary>
    ''' Donne la valeur en X du sommet
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function GetX() As Double
        Return Me.X
    End Function

    ''' <summary>
    ''' Donne la valeur en Y du sommet
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function GetY() As Double
        Return Me.Y
    End Function

    ''' <summary>
    ''' Donne la valeur en Z du sommet
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function GetZ() As Double
        Return Me.Z
    End Function


    Public Sub MettreAttributDoublonSommet(ByRef NomMaitre As String, ByRef Maitre As SldWorks.Vertex)
        ' on prend le s et on lui met un flag de doublon avec le nom du Maitre.

        ' Sub qui place l'attribut de faceinterne sur une face
        Dim attr As SldWorks.Attribute
        Dim ParamMaitre As SldWorks.Parameter
        Dim swent As SldWorks.Entity
        Static no As Integer = 1
        Dim nom As String

        ' v�rifier, si le NomMaitre a d�j� un maitre, il faut retrouver le vrai maitre
        swent = Maitre
        attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0)

        If Not attr Is Nothing Then ' le maitre �tait d�j� esclave... faut updater
            Dim p As SldWorks.Parameter
            p = attr.GetParameter("Maitre")
            NomMaitre = p.GetStringValue()
        End If

        attr = Nothing
        'Dim pt(2) As Double
        'pt = Me.swSommet.GetPoint

        nom = "DoublonSommet #" & no & " " & NomMaitre
        swent = Me.swSommet
        attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0) ' si l'attribut existe d�j� on pointe dessus.

        If attr Is Nothing Then attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, Me.swSommet, nom, 0, 2) ' 0 = swThisconfig

        While attr Is Nothing
            nom = "Doublon" & CStr(no)
            attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, Me.swSommet, nom, 0, 2)
            no += 1
            If no > 1000 Then MsgBox("Incapable de mettre un attribut sur un sommet non s�lectionnable!") : no -= 500 : Exit While
        End While

        ParamMaitre = attr.GetParameter("Maitre")
        ParamMaitre.SetStringValue2(NomMaitre, 2, "")  ' swAllConfiguration = 2

        'GererDossiers("Doublons", nom)
        no += 1
        Me.colorer()

    End Sub


    ''' <summary>
    ''' Colore le sommet pour l'identifier plus facilement
    ''' </summary>
    ''' <param name="rouge">Valeur du rouge (entre 0 et 255)</param>
    ''' <param name="vert">Valeur du vert (entre 0 et 255)</param>
    ''' <param name="bleu">Valeur du bleu (entre 0 et 255)</param>
    ''' <param name="epaisseur">La grosseur du point</param>
    ''' <remarks></remarks>
    Public Sub colorer(Optional ByVal rouge As Integer = 255, Optional ByVal vert As Integer = 0, Optional ByVal bleu As Integer = 0, Optional ByVal epaisseur As Double = 1.5)
        Me.swSommet.display(swModel, RGB(rouge, vert, bleu), epaisseur, True)
    End Sub


    ''' <summary>
    ''' S�lectionne l'ar�te, mais s'assure de ne pas la d�s�lectionner si elle est d�j� s�lectionn�e
    ''' </summary>
    ''' <remarks>Pas tr�s rapide...</remarks>
    Public Sub SelectionnerSafe()
        Dim swEnt As sldworks.Entity = Me.swSommet
        Dim selMgr As sldworks.SelectionMgr = swModel.SelectionManager

        For i As Integer = 1 To selMgr.GetSelectedObjectCount2(-1)
            If selMgr.GetSelectedObject6(i, -1) Is swEnt Then
                Exit Sub
            End If
        Next

        swEnt.Select4(True, Nothing)
    End Sub


    ''' <summary>
    ''' Retourne vrai si les 2 sommets sont identiques...
    ''' </summary>
    ''' <param name="swSommet"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function Comparer(ByRef swSommet As sldworks.Vertex) As Boolean
        If Commun.Distance(Me.swSommet, swSommet) < Epsilon Then Return True
    End Function

End Class
Revision:	130
Committed:	Wed Jul 30 21:26:03 2008 UTC (16 years, 9 months ago) by bournival
File size:	8895 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	Public Class SuperSommet
6			Inherits SuperEntite
7			Public swSommet As SldWorks.Vertex
8			Private Shared compteur As Long
9			Private Shared no As Long
10
11			Private Shared effacer As Integer
12
13			Public X As Double
14			Public Y As Double
15			Public Z As Double
16
17			Public Sub New(ByRef sommet As SldWorks.Vertex, Optional ByVal tip As Integer = 0)
18			swSommet = sommet
19
20			Select Case tip
21			Case Commun.tipe_e.Volume
22			nom = "Sommet" & compteur
23			Case Commun.tipe_e.coque
24			nom = "SommetCoque" & compteur
25			Case Commun.tipe_e.poutre
26			nom = "SommetPoutre" & compteur
27			End Select
28			nomOrig = nom
29			compteur += 1
30			End Sub
31
32			''' <summary>
33			''' Le new pour un encapsulateur temporaire....
34			''' </summary>
35			''' <param name="Sommet"></param>
36			''' <param name="temporaire">Mettre vrai...</param>
37			''' <remarks></remarks>
38			Public Sub New(ByRef Sommet As SldWorks.Vertex, ByRef temporaire As Boolean)
39			Dim vpoint As Object
40			Me.swSommet = Sommet
41			vpoint = swSommet.GetPoint()
42
43			Me.X = vpoint(0)
44			Me.Y = vpoint(1)
45			Me.Z = vpoint(2)
46
47			End Sub
48
49			Public Overrides Sub SaveNom()
50			Dim ent As SldWorks.Entity
51			ent = swSommet
52			Dim retval As Boolean
53			retval = swPart.SetEntityName(ent, nom)
54			Dim i As Integer
55			If retval = False Then
56			Do Until retval = True
57			i += 1
58			swPart.DeleteEntityName(ent)
59			retval = swPart.SetEntityName(ent, nom & Chr(96 + i))
60			ent.Select2(False, 0)
61
62			Dim vedge As Object
63			Dim edge As SldWorks.Edge
64			Dim nom1 As String, nom2 As String
65			vedge = swSommet.GetEdges()
66			edge = vedge(0) : ent = edge : nom1 = swPart.GetEntityName(ent)
67			edge = vedge(1) : ent = edge : nom2 = swPart.GetEntityName(ent)
68			If MsgBox("Le sommet " & nom & " a un probl�me pour se s�lectionner." & vbCr & nom1 & vbCr & nom2 & "Quitter?", MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then Err.Raise(555) : Exit Sub
69
70			Loop
71			End If
72
73			End Sub
74
75			Shared Sub reinitialiser()
76			compteur = 0
77			End Sub
78
79
80			Public Sub MettreAttributPourConditionLimite()
81			Dim swent As SldWorks.Entity
82			Dim nom As String
83			Dim cond As String
84
85			cond = Me.condition
86			If cond = "" Then Exit Sub
87
88
89			swent = Me.swSommet
90
91			nom = "CL" & CStr(no) & "_" & cond
92			Dim Attr As SldWorks.Attribute = Nothing
93
94			Try
95			Attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe d�j� on pointe dessus.
96			Catch ex As Exception
97			MsgBox("N'arrive pas � se lier � l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
98			End Try
99
100			If Attr Is Nothing Then Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.swSommet, nom, 0, 2) ' 0 = swThisconfig
101
102
103			While Attr Is Nothing
104			no += 1
105			nom = "CL" & CStr(no) & "_" & cond
106			Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.swSommet, nom, 0, 0)
107			End While
108
109
110			Dim ParamCL As SldWorks.Parameter
111			ParamCL = Attr.GetParameter("CL")
112
113			ParamCL.SetStringValue2(cond, 2, "") ' swAllConfiguration = 2
114
115
116			GererDossiers("Conditions Aux Limites", nom)
117			no = no + 1
118
119			End Sub
120
121			' une fonction qui transforme un attribut en condition aux limites
122			Public Sub AttributVersConditionLimite()
123			Dim p As SldWorks.Parameter
124			Dim ent As SldWorks.Entity
125			Dim attr As SldWorks.Attribute
126
127			ent = Me.swSommet
128			attr = ent.FindAttribute(Intersections.DefAttrConditionLimite, 0)
129			If Not attr Is Nothing Then
130			p = attr.GetParameter("CL")
131			nom = nomOrig & "@" & p.GetStringValue
132			End If
133
134			End Sub
135
136			Public Overrides Sub Selectionner(Optional ByVal Mark As Integer = 0, Optional ByRef Append As Boolean = True)
137			Dim swent As SldWorks.Entity
138			swent = swSommet
139	bournival	48	swent.Select2(Append, Mark)
140	bournival	40	End Sub
141
142
143
144
145			''' <summary>
146			''' Function qui retourne le pointeur sur le sommet
147			''' </summary>
148			''' <returns></returns>
149			''' <remarks></remarks>
150			Public Function GetSommet() As SldWorks.Vertex
151			Return Me.swSommet
152			End Function
153
154			''' <summary>
155			''' Donne la valeur en X du sommet
156			''' </summary>
157			''' <returns></returns>
158			''' <remarks></remarks>
159			Public Function GetX() As Double
160	bournival	48	Return Me.X
161	bournival	40	End Function
162
163			''' <summary>
164			''' Donne la valeur en Y du sommet
165			''' </summary>
166			''' <returns></returns>
167			''' <remarks></remarks>
168			Public Function GetY() As Double
169	bournival	48	Return Me.Y
170	bournival	40	End Function
171
172			''' <summary>
173			''' Donne la valeur en Z du sommet
174			''' </summary>
175			''' <returns></returns>
176			''' <remarks></remarks>
177			Public Function GetZ() As Double
178	bournival	48	Return Me.Z
179	bournival	40	End Function
180
181
182
183			Public Sub MettreAttributDoublonSommet(ByRef NomMaitre As String, ByRef Maitre As SldWorks.Vertex)
184			' on prend le s et on lui met un flag de doublon avec le nom du Maitre.
185
186			' Sub qui place l'attribut de faceinterne sur une face
187			Dim attr As SldWorks.Attribute
188			Dim ParamMaitre As SldWorks.Parameter
189			Dim swent As SldWorks.Entity
190			Static no As Integer = 1
191			Dim nom As String
192
193			' v�rifier, si le NomMaitre a d�j� un maitre, il faut retrouver le vrai maitre
194			swent = Maitre
195			attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0)
196
197			If Not attr Is Nothing Then ' le maitre �tait d�j� esclave... faut updater
198			Dim p As SldWorks.Parameter
199			p = attr.GetParameter("Maitre")
200			NomMaitre = p.GetStringValue()
201			End If
202
203			attr = Nothing
204			'Dim pt(2) As Double
205			'pt = Me.swSommet.GetPoint
206
207			nom = "DoublonSommet #" & no & " " & NomMaitre
208			swent = Me.swSommet
209			attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0) ' si l'attribut existe d�j� on pointe dessus.
210
211			If attr Is Nothing Then attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, Me.swSommet, nom, 0, 2) ' 0 = swThisconfig
212
213			While attr Is Nothing
214			nom = "Doublon" & CStr(no)
215			attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, Me.swSommet, nom, 0, 2)
216			no += 1
217	bournival	130	If no > 1000 Then MsgBox("Incapable de mettre un attribut sur un sommet non s�lectionnable!") : no -= 500 : Exit While
218	bournival	40	End While
219
220			ParamMaitre = attr.GetParameter("Maitre")
221			ParamMaitre.SetStringValue2(NomMaitre, 2, "") ' swAllConfiguration = 2
222
223	bournival	130	'GererDossiers("Doublons", nom)
224	bournival	40	no += 1
225			Me.colorer()
226
227			End Sub
228
229
230	bournival	46	''' <summary>
231			''' Colore le sommet pour l'identifier plus facilement
232			''' </summary>
233			''' <param name="rouge">Valeur du rouge (entre 0 et 255)</param>
234			''' <param name="vert">Valeur du vert (entre 0 et 255)</param>
235			''' <param name="bleu">Valeur du bleu (entre 0 et 255)</param>
236			''' <param name="epaisseur">La grosseur du point</param>
237			''' <remarks></remarks>
238	bournival	40	Public Sub colorer(Optional ByVal rouge As Integer = 255, Optional ByVal vert As Integer = 0, Optional ByVal bleu As Integer = 0, Optional ByVal epaisseur As Double = 1.5)
239			Me.swSommet.display(swModel, RGB(rouge, vert, bleu), epaisseur, True)
240			End Sub
241	bournival	130
242
243
244			''' <summary>
245			''' S�lectionne l'ar�te, mais s'assure de ne pas la d�s�lectionner si elle est d�j� s�lectionn�e
246			''' </summary>
247			''' <remarks>Pas tr�s rapide...</remarks>
248			Public Sub SelectionnerSafe()
249			Dim swEnt As sldworks.Entity = Me.swSommet
250			Dim selMgr As sldworks.SelectionMgr = swModel.SelectionManager
251
252			For i As Integer = 1 To selMgr.GetSelectedObjectCount2(-1)
253			If selMgr.GetSelectedObject6(i, -1) Is swEnt Then
254			Exit Sub
255			End If
256			Next
257
258			swEnt.Select4(True, Nothing)
259			End Sub
260
261
262			''' <summary>
263			''' Retourne vrai si les 2 sommets sont identiques...
264			''' </summary>
265			''' <param name="swSommet"></param>
266			''' <returns></returns>
267			''' <remarks></remarks>
268			Public Function Comparer(ByRef swSommet As sldworks.Vertex) As Boolean
269			If Commun.Distance(Me.swSommet, swSommet) < Epsilon Then Return True
270			End Function
271
272	bournival	40	End Class