| 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 |
If no > 1000 Then MsgBox("Incapable de mettre un attribut sur un sommet non sélectionnable!") : no -= 500 : Exit While
|
| 218 |
End While
|
| 219 |
|
| 220 |
ParamMaitre = attr.GetParameter("Maitre")
|
| 221 |
ParamMaitre.SetStringValue2(NomMaitre, 2, "") ' swAllConfiguration = 2
|
| 222 |
|
| 223 |
'GererDossiers("Doublons", nom)
|
| 224 |
no += 1
|
| 225 |
Me.colorer()
|
| 226 |
|
| 227 |
End Sub
|
| 228 |
|
| 229 |
|
| 230 |
''' <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 |
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 |
|
| 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 |
End Class
|
