REPOS_ERICCA/magicsld/SuperSommet.vb

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:	46
Committed:	Wed Aug 22 18:28:53 2007 UTC (17 years, 9 months ago) by bournival
File size:	7682 byte(s)
Log Message:	Ajout de la page de prÃ©-optimisation automatique et des modification que j'ai apportÃ©es.
#	Content
1	Public Class SuperSommet
2	Inherits SuperEntite
3	Public swSommet As SldWorks.Vertex
4	Private Shared compteur As Long
5	Private Shared no As Long
6
7	Private Shared effacer As Integer
8
9	Public X As Double
10	Public Y As Double
11	Public Z As Double
12
13	Public Sub New(ByRef sommet As SldWorks.Vertex, Optional ByVal tip As Integer = 0)
14	swSommet = sommet
15
16	Select Case tip
17	Case Commun.tipe_e.Volume
18	nom = "Sommet" & compteur
19	Case Commun.tipe_e.coque
20	nom = "SommetCoque" & compteur
21	Case Commun.tipe_e.poutre
22	nom = "SommetPoutre" & compteur
23	End Select
24	nomOrig = nom
25	compteur += 1
26	End Sub
27
28	''' <summary>
29	''' Le new pour un encapsulateur temporaire....
30	''' </summary>
31	''' <param name="Sommet"></param>
32	''' <param name="temporaire">Mettre vrai...</param>
33	''' <remarks></remarks>
34	Public Sub New(ByRef Sommet As SldWorks.Vertex, ByRef temporaire As Boolean)
35	Dim vpoint As Object
36	Me.swSommet = Sommet
37	vpoint = swSommet.GetPoint()
38
39	Me.X = vpoint(0)
40	Me.Y = vpoint(1)
41	Me.Z = vpoint(2)
42
43	End Sub
44
45	Public Overrides Sub SaveNom()
46	Dim ent As SldWorks.Entity
47	ent = swSommet
48	Dim retval As Boolean
49	retval = swPart.SetEntityName(ent, nom)
50	Dim i As Integer
51	If retval = False Then
52	Do Until retval = True
53	i += 1
54	swPart.DeleteEntityName(ent)
55	retval = swPart.SetEntityName(ent, nom & Chr(96 + i))
56	ent.Select2(False, 0)
57
58	Dim vedge As Object
59	Dim edge As SldWorks.Edge
60	Dim nom1 As String, nom2 As String
61	vedge = swSommet.GetEdges()
62	edge = vedge(0) : ent = edge : nom1 = swPart.GetEntityName(ent)
63	edge = vedge(1) : ent = edge : nom2 = swPart.GetEntityName(ent)
64	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
65
66	Loop
67	End If
68
69	End Sub
70
71	Shared Sub reinitialiser()
72	compteur = 0
73	End Sub
74
75
76	Public Sub MettreAttributPourConditionLimite()
77	Dim swent As SldWorks.Entity
78	Dim nom As String
79	Dim cond As String
80
81	cond = Me.condition
82	If cond = "" Then Exit Sub
83
84
85	swent = Me.swSommet
86
87	nom = "CL" & CStr(no) & "_" & cond
88	Dim Attr As SldWorks.Attribute = Nothing
89
90	Try
91	Attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
92	Catch ex As Exception
93	MsgBox("N'arrive pas à se lier à l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
94	End Try
95
96	If Attr Is Nothing Then Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.swSommet, nom, 0, 2) ' 0 = swThisconfig
97
98
99	While Attr Is Nothing
100	no += 1
101	nom = "CL" & CStr(no) & "_" & cond
102	Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.swSommet, nom, 0, 0)
103	End While
104
105
106	Dim ParamCL As SldWorks.Parameter
107	ParamCL = Attr.GetParameter("CL")
108
109	ParamCL.SetStringValue2(cond, 2, "") ' swAllConfiguration = 2
110
111
112	GererDossiers("Conditions Aux Limites", nom)
113	no = no + 1
114
115	End Sub
116
117	' une fonction qui transforme un attribut en condition aux limites
118	Public Sub AttributVersConditionLimite()
119	Dim p As SldWorks.Parameter
120	Dim ent As SldWorks.Entity
121	Dim attr As SldWorks.Attribute
122
123	ent = Me.swSommet
124	attr = ent.FindAttribute(Intersections.DefAttrConditionLimite, 0)
125	If Not attr Is Nothing Then
126	p = attr.GetParameter("CL")
127	nom = nomOrig & "@" & p.GetStringValue
128	End If
129
130	End Sub
131
132	Public Overrides Sub Selectionner(Optional ByVal Mark As Integer = 0, Optional ByRef Append As Boolean = True)
133	Dim swent As SldWorks.Entity
134	swent = swSommet
135	swent.Select2(append, Mark)
136	End Sub
137
138
139
140
141	''' <summary>
142	''' Function qui retourne le pointeur sur le sommet
143	''' </summary>
144	''' <returns></returns>
145	''' <remarks></remarks>
146	Public Function GetSommet() As SldWorks.Vertex
147	Return Me.swSommet
148	End Function
149
150	''' <summary>
151	''' Donne la valeur en X du sommet
152	''' </summary>
153	''' <returns></returns>
154	''' <remarks></remarks>
155	Public Function GetX() As Double
156	Return Me.x
157	End Function
158
159	''' <summary>
160	''' Donne la valeur en Y du sommet
161	''' </summary>
162	''' <returns></returns>
163	''' <remarks></remarks>
164	Public Function GetY() As Double
165	Return Me.y
166	End Function
167
168	''' <summary>
169	''' Donne la valeur en Z du sommet
170	''' </summary>
171	''' <returns></returns>
172	''' <remarks></remarks>
173	Public Function GetZ() As Double
174	Return Me.z
175	End Function
176
177
178
179	Public Sub MettreAttributDoublonSommet(ByRef NomMaitre As String, ByRef Maitre As SldWorks.Vertex)
180	' on prend le s et on lui met un flag de doublon avec le nom du Maitre.
181
182	' Sub qui place l'attribut de faceinterne sur une face
183	Dim attr As SldWorks.Attribute
184	Dim ParamMaitre As SldWorks.Parameter
185	Dim swent As SldWorks.Entity
186	Static no As Integer = 1
187	Dim nom As String
188
189	' vérifier, si le NomMaitre a déjà un maitre, il faut retrouver le vrai maitre
190	swent = Maitre
191	attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0)
192
193	If Not attr Is Nothing Then ' le maitre était déjà esclave... faut updater
194	Dim p As SldWorks.Parameter
195	p = attr.GetParameter("Maitre")
196	NomMaitre = p.GetStringValue()
197	End If
198
199	attr = Nothing
200	'Dim pt(2) As Double
201	'pt = Me.swSommet.GetPoint
202
203	nom = "DoublonSommet #" & no & " " & NomMaitre
204	swent = Me.swSommet
205	attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0) ' si l'attribut existe déjà on pointe dessus.
206
207	If attr Is Nothing Then attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, Me.swSommet, nom, 0, 2) ' 0 = swThisconfig
208
209	While attr Is Nothing
210	nom = "Doublon" & CStr(no)
211	attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, Me.swSommet, nom, 0, 2)
212	no += 1
213	End While
214
215	ParamMaitre = attr.GetParameter("Maitre")
216	ParamMaitre.SetStringValue2(NomMaitre, 2, "") ' swAllConfiguration = 2
217
218	GererDossiers("Doublons", nom)
219	no += 1
220	Me.colorer()
221
222	End Sub
223
224
225	''' <summary>
226	''' Colore le sommet pour l'identifier plus facilement
227	''' </summary>
228	''' <param name="rouge">Valeur du rouge (entre 0 et 255)</param>
229	''' <param name="vert">Valeur du vert (entre 0 et 255)</param>
230	''' <param name="bleu">Valeur du bleu (entre 0 et 255)</param>
231	''' <param name="epaisseur">La grosseur du point</param>
232	''' <remarks></remarks>
233	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)
234	Me.swSommet.display(swModel, RGB(rouge, vert, bleu), epaisseur, True)
235	End Sub
236	End Class