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
        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
End Class
Revision:	48
Committed:	Wed Aug 22 21:18:12 2007 UTC (17 years, 9 months ago) by bournival
File size:	7788 byte(s)
Log Message:	On passe aux nouveaux .dll
#	Content
1	Imports SolidWorks.Interop
2	Imports SolidWorks.Interop.swconst
3	Imports SolidWorks.Interop.swpublished
4
5	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	swent.Select2(Append, Mark)
140	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	Return Me.X
161	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	Return Me.Y
170	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	Return Me.Z
179	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	End While
218
219	ParamMaitre = attr.GetParameter("Maitre")
220	ParamMaitre.SetStringValue2(NomMaitre, 2, "") ' swAllConfiguration = 2
221
222	GererDossiers("Doublons", nom)
223	no += 1
224	Me.colorer()
225
226	End Sub
227
228
229	''' <summary>
230	''' Colore le sommet pour l'identifier plus facilement
231	''' </summary>
232	''' <param name="rouge">Valeur du rouge (entre 0 et 255)</param>
233	''' <param name="vert">Valeur du vert (entre 0 et 255)</param>
234	''' <param name="bleu">Valeur du bleu (entre 0 et 255)</param>
235	''' <param name="epaisseur">La grosseur du point</param>
236	''' <remarks></remarks>
237	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)
238	Me.swSommet.display(swModel, RGB(rouge, vert, bleu), epaisseur, True)
239	End Sub
240	End Class