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


    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:	40
Committed:	Mon Aug 20 21:30:28 2007 UTC (17 years, 8 months ago) by bournival
File size:	7288 byte(s)
Log Message:	Projet de these de Sylvain Bournival. Attention projet VB.
#	User	Rev	Content
1	bournival	40	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
226			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)
227			Me.swSommet.display(swModel, RGB(rouge, vert, bleu), epaisseur, True)
228			End Sub
229			End Class