| 1 |
Imports SolidWorks.Interop
|
| 2 |
Imports SolidWorks.Interop.swconst
|
| 3 |
Imports SolidWorks.Interop.swpublished
|
| 4 |
|
| 5 |
Module Commun
|
| 6 |
|
| 7 |
Public Const Pi As Double = 3.1415926535897931
|
| 8 |
Public Epsilon As Double = 0.000000001 'à changer en fonction du type d'unité utilisé
|
| 9 |
|
| 10 |
Public Imax As Double = 1 ' valeur maximale de l'inertie.
|
| 11 |
Public Amax As Double = 1000 ' et de l'aire
|
| 12 |
|
| 13 |
Public NBAreteDoublon As Integer ' sais pas où d'autre ne peut mémoriser ce nombre...
|
| 14 |
|
| 15 |
Public swApp As SldWorks.SldWorks
|
| 16 |
Public swPart As SldWorks.PartDoc
|
| 17 |
Public swModel As SldWorks.ModelDoc2
|
| 18 |
|
| 19 |
Public lst_AreteVolume As New Collections.ObjectModel.Collection(Of SlyAreteVol) ' liste de courbes appartenant au volume
|
| 20 |
Public lst_AreteCoque As New Collections.ObjectModel.Collection(Of SlyAreteCoque) ' liste de courbes appartenant aux coques
|
| 21 |
Public lst_AretePoutre As New Collections.ObjectModel.Collection(Of SlyAretePoutre) ' liste de courbe libres
|
| 22 |
Public lst_FaceVolume As New Collections.Generic.List(Of SlyFaceVolume) ' liste de faces appartenant au volume
|
| 23 |
Public lst_FaceCoque As New Collections.ObjectModel.Collection(Of SlyFaceCoque) ' liste de face libres
|
| 24 |
Public lst_SommetVolume As New Collections.ObjectModel.Collection(Of SlySommetVolume)
|
| 25 |
Public lst_SommetCoque As New Collections.ObjectModel.Collection(Of SlySommetCoque)
|
| 26 |
Public lst_sommetPoutre As New Collections.ObjectModel.Collection(Of SlySommetPoutre)
|
| 27 |
|
| 28 |
Public ENG As Double
|
| 29 |
Private NameFichierPog As String
|
| 30 |
|
| 31 |
Public lst_AreteDoublon As New Collection
|
| 32 |
|
| 33 |
Public OptionMettreNoteIntersection As Boolean = True
|
| 34 |
|
| 35 |
|
| 36 |
Public Structure sectionPoutre
|
| 37 |
Dim nom As String
|
| 38 |
Dim I1 As Double
|
| 39 |
Dim I2 As Double
|
| 40 |
Dim D1 As Double
|
| 41 |
Dim D2 As Double
|
| 42 |
Dim D3 As Double
|
| 43 |
Dim D4 As Double
|
| 44 |
Dim D5 As Double
|
| 45 |
Dim D6 As Double
|
| 46 |
Dim Aire As Double
|
| 47 |
End Structure
|
| 48 |
|
| 49 |
|
| 50 |
|
| 51 |
Public Enum tipe_e
|
| 52 |
Volume = 0
|
| 53 |
coque = 1
|
| 54 |
poutre = 2
|
| 55 |
MiniPoutre = 3
|
| 56 |
End Enum
|
| 57 |
|
| 58 |
''' <summary>
|
| 59 |
''' L'écart nodal Global (ENG).
|
| 60 |
''' </summary>
|
| 61 |
''' <value></value>
|
| 62 |
''' <returns></returns>
|
| 63 |
''' <remarks>Doit être mémorisé ici pour pouvoir l'utiliser partout...</remarks>
|
| 64 |
Public Property ÉcartNodal() As Double
|
| 65 |
Get
|
| 66 |
Return ENG
|
| 67 |
End Get
|
| 68 |
Set(ByVal value As Double)
|
| 69 |
ENG = value
|
| 70 |
End Set
|
| 71 |
End Property
|
| 72 |
|
| 73 |
Public Property NomFichierPog() As String
|
| 74 |
Get
|
| 75 |
Return NameFichierPog
|
| 76 |
End Get
|
| 77 |
Set(ByVal value As String)
|
| 78 |
NameFichierPog = value
|
| 79 |
End Set
|
| 80 |
End Property
|
| 81 |
|
| 82 |
|
| 83 |
Public Sub GenererListes(Optional ByVal ChercheAttribut As Boolean = True)
|
| 84 |
' sub qui créé les entités Sly... et le met dans les listes
|
| 85 |
|
| 86 |
Dim vBodies As Object
|
| 87 |
Dim swBody As SldWorks.Body2
|
| 88 |
Dim v As Integer
|
| 89 |
Dim swFace As SldWorks.Face2
|
| 90 |
Dim swLoop As SldWorks.Loop2
|
| 91 |
Dim swCoArete As SldWorks.CoEdge
|
| 92 |
Dim swArete As SldWorks.Edge
|
| 93 |
Dim swSommet1 As SldWorks.Vertex
|
| 94 |
Dim swSommet2 As SldWorks.Vertex
|
| 95 |
'Dim nouveau As Boolean ' bit qui dit si on est entrain d'updater (false) ou si on recommence du début (true)
|
| 96 |
|
| 97 |
' on doit commencer par vider les listes, sinon on peut travailler sur les listes d'un autre fichier...
|
| 98 |
' ne vérifie plus si on update ou si on recommence, ce n'est plus nécessaire.
|
| 99 |
Intersections.RegisterAttribut()
|
| 100 |
|
| 101 |
videliste()
|
| 102 |
Call SuperFace.reinitialiser() ' remet les compteurs à 0
|
| 103 |
Call SuperArete.reinitialiser()
|
| 104 |
Call SuperSommet.reinitialiser()
|
| 105 |
|
| 106 |
vBodies = swPart.GetBodies2(swconst.swBodyType_e.swSolidBody, True)
|
| 107 |
If Not vBodies Is Nothing Then
|
| 108 |
For v = 0 To UBound(vBodies)
|
| 109 |
swBody = vBodies(v)
|
| 110 |
swFace = swBody.GetFirstFace
|
| 111 |
|
| 112 |
Do While Not swFace Is Nothing
|
| 113 |
If trouver(swFace, tipe_e.Volume) Is Nothing Then
|
| 114 |
Dim slyface As New SlyFaceVolume(swFace)
|
| 115 |
lst_FaceVolume.Add(slyface)
|
| 116 |
End If
|
| 117 |
|
| 118 |
|
| 119 |
swLoop = swFace.GetFirstLoop
|
| 120 |
Do While Not swLoop Is Nothing
|
| 121 |
|
| 122 |
swCoArete = swLoop.GetFirstCoEdge
|
| 123 |
Dim coa As Integer
|
| 124 |
For coa = 0 To swLoop.GetEdgeCount - 1
|
| 125 |
|
| 126 |
swArete = swCoArete.GetEdge
|
| 127 |
If (Not Ignorer(swArete)) Then
|
| 128 |
If trouver(swArete, tipe_e.Volume, True) Is Nothing Then
|
| 129 |
Dim slyArete As New SlyAreteVol(swArete)
|
| 130 |
lst_AreteVolume.Add(slyArete)
|
| 131 |
End If
|
| 132 |
|
| 133 |
swSommet1 = swArete.GetStartVertex
|
| 134 |
If IsNothing(swSommet1) Then
|
| 135 |
'MsgBox("On a une courbe sans sommet")
|
| 136 |
Else
|
| 137 |
If (trouver(swSommet1, tipe_e.Volume) Is Nothing) Then
|
| 138 |
Dim slySommet As New SlySommetVolume(swSommet1)
|
| 139 |
lst_SommetVolume.Add(slySommet)
|
| 140 |
End If
|
| 141 |
|
| 142 |
swSommet2 = swArete.GetEndVertex
|
| 143 |
If (trouver(swSommet2, tipe_e.Volume) Is Nothing) Then
|
| 144 |
Dim slySommet As New SlySommetVolume(swSommet2)
|
| 145 |
lst_SommetVolume.Add(slySommet)
|
| 146 |
End If
|
| 147 |
End If
|
| 148 |
|
| 149 |
swCoArete = swCoArete.GetNext
|
| 150 |
End If
|
| 151 |
Next coa ' fin de loop sur les coaretes
|
| 152 |
|
| 153 |
swLoop = swLoop.GetNext
|
| 154 |
Loop ' fin loop sur loop
|
| 155 |
|
| 156 |
swFace = swFace.GetNextFace()
|
| 157 |
Loop ' fin loop sur faces
|
| 158 |
Next v ' next volume
|
| 159 |
End If ' s'il y a un corps (ou plus) on entre dans la boucle, sinon on continue sur les coques et poutres
|
| 160 |
|
| 161 |
|
| 162 |
|
| 163 |
' on fait le tour des features pour avoir les poutres et les coques
|
| 164 |
Dim feat As SldWorks.Feature
|
| 165 |
Dim vSupprime As Object
|
| 166 |
Dim bSupprime As Boolean
|
| 167 |
Dim ent As SldWorks.Entity
|
| 168 |
Dim attr As SldWorks.Attribute
|
| 169 |
|
| 170 |
|
| 171 |
feat = swPart.FirstFeature
|
| 172 |
|
| 173 |
Do While Not feat Is Nothing
|
| 174 |
|
| 175 |
vSupprime = feat.IsSuppressed
|
| 176 |
bSupprime = CBool(vSupprime)
|
| 177 |
If Not bSupprime Then ' on vérifie que l'entité est pas supprimée
|
| 178 |
Try
|
| 179 |
Select Case feat.GetTypeName
|
| 180 |
Case "CompositeCurve", "3DSplineCurve" ', "Helix" 'le feature est une courbe libre
|
| 181 |
|
| 182 |
Dim refCourbe As sldworks.ReferenceCurve
|
| 183 |
|
| 184 |
refCourbe = feat.GetSpecificFeature2
|
| 185 |
swArete = refCourbe.GetFirstSegment
|
| 186 |
Do While Not swArete Is Nothing
|
| 187 |
|
| 188 |
If (Not Ignorer(swArete)) Then
|
| 189 |
Dim slyArete As SlyAretePoutre
|
| 190 |
slyArete = trouver(swArete, tipe_e.poutre)
|
| 191 |
|
| 192 |
If slyArete Is Nothing Then
|
| 193 |
slyArete = New SlyAretePoutre(swArete)
|
| 194 |
lst_AretePoutre.Add(slyArete)
|
| 195 |
End If
|
| 196 |
|
| 197 |
swSommet1 = swArete.GetStartVertex
|
| 198 |
If IsNothing(swSommet1) Then
|
| 199 |
'MsgBox("On a une courbe sans sommet")
|
| 200 |
Else
|
| 201 |
If trouver(swSommet1, tipe_e.poutre) Is Nothing Then
|
| 202 |
Dim slySommet As New SlySommetPoutre(swSommet1)
|
| 203 |
lst_sommetPoutre.Add(slySommet)
|
| 204 |
End If
|
| 205 |
|
| 206 |
swSommet2 = swArete.GetEndVertex
|
| 207 |
If trouver(swSommet2, tipe_e.poutre) Is Nothing Then
|
| 208 |
Dim slySommet As New SlySommetPoutre(swSommet2)
|
| 209 |
lst_sommetPoutre.Add(slySommet)
|
| 210 |
End If
|
| 211 |
End If
|
| 212 |
|
| 213 |
' on cherche s'il n'y aurait pas un attribut sur la poutre
|
| 214 |
'If ChercheAttribut Then
|
| 215 |
Try
|
| 216 |
ent = swArete
|
| 217 |
attr = ent.FindAttribute(Intersections.DefAttrRCP1, 0)
|
| 218 |
slyArete.swAttribute = attr
|
| 219 |
If Left(attr.GetName, 4) = "Mini" Then swArete.Display(2, 1, 0, 1, True) Else swArete.Display(2, 0, 1, 0, True)
|
| 220 |
'Dim xyz() As Double
|
| 221 |
'xyz = slyarete.GetPoint3
|
| 222 |
'slyarete.X3 = xyz(0)
|
| 223 |
'slyarete.y3 = xyz(1)
|
| 224 |
'slyarete.z3 = xyz(2)
|
| 225 |
Catch ex As Exception
|
| 226 |
MsgBox("Une poutre sans attributs est détectée dans le modèle!")
|
| 227 |
End Try
|
| 228 |
|
| 229 |
End If
|
| 230 |
|
| 231 |
swArete = Nothing
|
| 232 |
swArete = refCourbe.GetNextSegment
|
| 233 |
|
| 234 |
Loop
|
| 235 |
|
| 236 |
|
| 237 |
Case "PLine", "ExtruRefSurface", "RevolvRefSurf", "SweepRefSurface", "BlendRefSurface", "OffsetRefSurface", "ExtendRefSurface", "PlanarSurface", "RadiateRefSurface", "MidRefSurface", "FillRefSurface", "RefSurface"
|
| 238 |
|
| 239 |
' le feature est une surface libre, certains types de surface n'ont pas été gardés car
|
| 240 |
' leur face appartient à un autre feature ou parce qu'il sont impossible à retrouver dans un multimodèle
|
| 241 |
|
| 242 |
|
| 243 |
' Attention, si c'est une PLine ça peut prendre un volume
|
| 244 |
|
| 245 |
Dim body As sldworks.Body2
|
| 246 |
Dim vFaces As Object
|
| 247 |
Dim vf As Object
|
| 248 |
Dim slyFace As SlyFaceCoque
|
| 249 |
Dim ShellBody As sldworks.Body2
|
| 250 |
|
| 251 |
vFaces = feat.GetFaces
|
| 252 |
If Not vFaces Is Nothing Then
|
| 253 |
For Each vf In vFaces
|
| 254 |
swFace = vf
|
| 255 |
ShellBody = swFace.GetBody : If ShellBody.Visible = False Then Continue For
|
| 256 |
body = swFace.GetBody
|
| 257 |
|
| 258 |
|
| 259 |
If Not (body.GetType = swconst.swBodyType_e.swSolidBody) Then ' si le body est quelquechose de solide alors on a le feature Pline d'un solide....
|
| 260 |
|
| 261 |
slyFace = trouver(swFace, tipe_e.coque)
|
| 262 |
If slyFace Is Nothing Then
|
| 263 |
|
| 264 |
slyFace = New SlyFaceCoque(swFace)
|
| 265 |
lst_FaceCoque.Add(slyFace)
|
| 266 |
End If
|
| 267 |
|
| 268 |
|
| 269 |
' ***** détection des attributs des coques
|
| 270 |
attr = Nothing
|
| 271 |
If ChercheAttribut Then
|
| 272 |
Try
|
| 273 |
ent = swFace
|
| 274 |
attr = ent.FindAttribute(Intersections.DefAttrRCCoque, 0)
|
| 275 |
slyFace.swAttribute = attr
|
| 276 |
Catch ex As Exception
|
| 277 |
MsgBox("Une coque sans attributs est détectée dans le modèle!")
|
| 278 |
End Try
|
| 279 |
|
| 280 |
If IsNothing(attr) Then ' on a trouvé un attribut de coque
|
| 281 |
'il n'y a pas encore d'attributs sur cette coque.
|
| 282 |
'MsgBox("Le putain d'attribut n'a pas été détecté!")
|
| 283 |
End If
|
| 284 |
End If
|
| 285 |
|
| 286 |
swLoop = swFace.GetFirstLoop
|
| 287 |
Do While Not swLoop Is Nothing
|
| 288 |
swCoArete = swLoop.GetFirstCoEdge
|
| 289 |
Dim coa As Integer
|
| 290 |
For coa = 0 To swLoop.GetEdgeCount - 1
|
| 291 |
|
| 292 |
swArete = swCoArete.GetEdge
|
| 293 |
|
| 294 |
If (Not Ignorer(swArete)) Then
|
| 295 |
If trouver(swArete, tipe_e.coque) Is Nothing Then
|
| 296 |
Dim slyArete As New SlyAreteCoque(swArete)
|
| 297 |
lst_AreteCoque.Add(slyArete)
|
| 298 |
End If
|
| 299 |
|
| 300 |
swSommet1 = swArete.GetStartVertex
|
| 301 |
If IsNothing(swSommet1) Then
|
| 302 |
'MsgBox("On a une courbe sans sommet")
|
| 303 |
Else
|
| 304 |
If trouver(swSommet1, tipe_e.coque) Is Nothing Then
|
| 305 |
Dim slySommet As New SlySommetCoque(swSommet1)
|
| 306 |
lst_SommetCoque.Add(slySommet)
|
| 307 |
End If
|
| 308 |
|
| 309 |
swSommet2 = swArete.GetEndVertex
|
| 310 |
If trouver(swSommet2, tipe_e.coque) Is Nothing Then
|
| 311 |
Dim slySommet As New SlySommetCoque(swSommet2)
|
| 312 |
lst_SommetCoque.Add(slySommet)
|
| 313 |
End If
|
| 314 |
End If
|
| 315 |
|
| 316 |
swCoArete = swCoArete.GetNext
|
| 317 |
End If
|
| 318 |
Next coa ' fin de loop sur les coaretes
|
| 319 |
|
| 320 |
swLoop = swLoop.GetNext
|
| 321 |
Loop ' fin loop sur loop
|
| 322 |
Else
|
| 323 |
'MsgBox("On vient de retirer une PLine appartenant à un volume!", MsgBoxStyle.Exclamation)
|
| 324 |
End If
|
| 325 |
Next vf
|
| 326 |
End If
|
| 327 |
|
| 328 |
Case Else ' n'est pas un feature intéressant...
|
| 329 |
' rien
|
| 330 |
End Select
|
| 331 |
Catch
|
| 332 |
MsgBox("Générer liste n'a pas marché sur le feature: " & feat.Name)
|
| 333 |
End Try
|
| 334 |
|
| 335 |
End If ' fin du if sur la suppression du feature
|
| 336 |
feat = feat.GetNextFeature
|
| 337 |
Loop
|
| 338 |
|
| 339 |
End Sub
|
| 340 |
|
| 341 |
Public Sub MettreNoms()
|
| 342 |
' place les noms des SlyClasses sur les entités puis sauvegarde
|
| 343 |
|
| 344 |
'Debug.Write(" Title = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoTitle))
|
| 345 |
'Debug.Write(" Subject = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoSubject))
|
| 346 |
'Debug.Write(" Author = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoAuthor))
|
| 347 |
'Debug.Write(" Keywords = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoKeywords))
|
| 348 |
'Debug.Write(" Comment = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoComment))
|
| 349 |
'Debug.Write(" SavedBy = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoSavedBy))
|
| 350 |
'Debug.Write(" CreateDate = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoCreateDate))
|
| 351 |
'Debug.Write(" SaveDate = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoSaveDate))
|
| 352 |
'Debug.Write(" CreateDate2 = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoCreateDate2))
|
| 353 |
'Debug.Write(" SaveDate2 = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoSaveDate2))
|
| 354 |
Static saveModel As SldWorks.ModelDoc2
|
| 355 |
Static passe As Boolean = False
|
| 356 |
|
| 357 |
If (swModel Is saveModel) And (passe = True) Then
|
| 358 |
Exit Sub ' faudrait pas passer 2 fois dans le mettrenoms...
|
| 359 |
Else
|
| 360 |
saveModel = swModel
|
| 361 |
End If
|
| 362 |
passe = True
|
| 363 |
|
| 364 |
|
| 365 |
'VideNom() ' on commence par enlever les noms (on suppose qu'il n'y en a pas déjà...)
|
| 366 |
|
| 367 |
Dim s1 As SlyAreteVol
|
| 368 |
For Each s1 In lst_AreteVolume
|
| 369 |
s1.SaveNom()
|
| 370 |
Next
|
| 371 |
|
| 372 |
Dim s2 As SlyAreteCoque
|
| 373 |
For Each s2 In lst_AreteCoque
|
| 374 |
s2.SaveNom()
|
| 375 |
Next
|
| 376 |
|
| 377 |
Dim s3 As SlyAretePoutre
|
| 378 |
For Each s3 In lst_AretePoutre
|
| 379 |
s3.SaveNom()
|
| 380 |
Next
|
| 381 |
|
| 382 |
Dim s4 As SlyFaceVolume
|
| 383 |
For Each s4 In lst_FaceVolume
|
| 384 |
s4.SaveNom()
|
| 385 |
Next
|
| 386 |
|
| 387 |
Dim s5 As SlyFaceCoque
|
| 388 |
For Each s5 In lst_FaceCoque
|
| 389 |
s5.SaveNom()
|
| 390 |
Next
|
| 391 |
|
| 392 |
Dim s6 As SlySommetVolume
|
| 393 |
For Each s6 In lst_SommetVolume
|
| 394 |
s6.SaveNom()
|
| 395 |
Next
|
| 396 |
|
| 397 |
Dim s7 As SlySommetCoque
|
| 398 |
For Each s7 In lst_SommetCoque
|
| 399 |
s7.SaveNom()
|
| 400 |
Next
|
| 401 |
|
| 402 |
Dim s8 As SlySommetPoutre
|
| 403 |
For Each s8 In lst_sommetPoutre
|
| 404 |
s8.SaveNom()
|
| 405 |
Next
|
| 406 |
|
| 407 |
End Sub
|
| 408 |
|
| 409 |
Public Sub videliste(Of T)(ByRef liste As Collections.Generic.List(Of T))
|
| 410 |
liste.Clear()
|
| 411 |
End Sub
|
| 412 |
|
| 413 |
|
| 414 |
Public Sub videliste()
|
| 415 |
lst_AreteVolume.Clear()
|
| 416 |
lst_AreteCoque.Clear()
|
| 417 |
lst_AretePoutre.Clear()
|
| 418 |
lst_FaceVolume.Clear()
|
| 419 |
lst_FaceCoque.Clear()
|
| 420 |
lst_SommetVolume.Clear()
|
| 421 |
lst_SommetCoque.Clear()
|
| 422 |
lst_SommetCoque.Clear()
|
| 423 |
lst_sommetPoutre.Clear()
|
| 424 |
|
| 425 |
End Sub
|
| 426 |
|
| 427 |
Public Overloads Function getNom(ByRef swEnt As sldworks.Entity) As String
|
| 428 |
getNom = swPart.GetEntityName(swEnt)
|
| 429 |
End Function
|
| 430 |
|
| 431 |
Public Overloads Function getNom(ByRef swFace As sldworks.Face2) As String
|
| 432 |
Dim swEnt As sldworks.Entity
|
| 433 |
swEnt = swFace
|
| 434 |
getNom = swPart.GetEntityName(swEnt)
|
| 435 |
End Function
|
| 436 |
|
| 437 |
Public Overloads Function getNom(ByRef swArete As sldworks.Edge) As String
|
| 438 |
Dim swEnt As sldworks.Entity
|
| 439 |
swEnt = swArete
|
| 440 |
getNom = swPart.GetEntityName(swEnt)
|
| 441 |
End Function
|
| 442 |
|
| 443 |
Public Overloads Function getNom(ByRef swSommet As sldworks.Vertex) As String
|
| 444 |
Dim swEnt As sldworks.Entity
|
| 445 |
swEnt = swSommet
|
| 446 |
getNom = swPart.GetEntityName(swEnt)
|
| 447 |
End Function
|
| 448 |
|
| 449 |
Public Sub GererDossiers(ByRef nomDossier As String, ByRef NomFeature As String)
|
| 450 |
' déplace un feature dans un dossier ( et créé le dossier si ce n'est pas déjà fait)
|
| 451 |
|
| 452 |
Static copienom As String
|
| 453 |
Dim swFeat As SldWorks.Feature
|
| 454 |
Dim ok As Boolean
|
| 455 |
Dim j As Integer
|
| 456 |
|
| 457 |
If Not StrComp(nomDossier, copienom) Then
|
| 458 |
' on commence par vérifier qu'il n'est pas déjà créé
|
| 459 |
|
| 460 |
swFeat = swModel.FirstFeature
|
| 461 |
|
| 462 |
Do While Not swFeat Is Nothing
|
| 463 |
If swFeat.GetTypeName = "FtrFolder" And swFeat.Name = nomDossier Then GoTo suite
|
| 464 |
swFeat = swFeat.GetNextFeature
|
| 465 |
Loop
|
| 466 |
|
| 467 |
'on mémorise tout ce qui est sélectionné
|
| 468 |
Dim lst_selection As New Collection
|
| 469 |
Dim selMgr As sldworks.SelectionMgr
|
| 470 |
selMgr = swModel.SelectionManager
|
| 471 |
|
| 472 |
For j = 1 To selMgr.GetSelectedObjectCount
|
| 473 |
lst_selection.Add(selMgr.GetSelectedObject5(j))
|
| 474 |
Next j
|
| 475 |
swModel.ClearSelection2(True)
|
| 476 |
|
| 477 |
|
| 478 |
Dim folder As SldWorks.Feature
|
| 479 |
Dim featMgr As SldWorks.FeatureManager
|
| 480 |
featMgr = swModel.FeatureManager
|
| 481 |
swModel.ClearSelection2(True)
|
| 482 |
|
| 483 |
' on doit mettre le folder à la fin sinon le feature risque d'être avant un parent
|
| 484 |
j = 0
|
| 485 |
swFeat = swModel.FeatureByPositionReverse(0)
|
| 486 |
While Not ok
|
| 487 |
j = j + 1
|
| 488 |
If swFeat.GetTypeName = "ProfileFeature" Or swFeat.GetTypeName = "3DProfileFeature" Then swFeat = swModel.FeatureByPositionReverse(j) Else ok = True
|
| 489 |
End While
|
| 490 |
|
| 491 |
swFeat.Select(False)
|
| 492 |
folder = featMgr.InsertFeatureTreeFolder2(1)
|
| 493 |
If Not folder Is Nothing Then folder.Name = nomDossier
|
| 494 |
folder = Nothing
|
| 495 |
swPart.ReorderFeature(nomDossier, swFeat.Name)
|
| 496 |
|
| 497 |
folder = Nothing
|
| 498 |
|
| 499 |
' on resélectionne les objets
|
| 500 |
swModel.ClearSelection2(True)
|
| 501 |
For j = 1 To lst_selection.Count
|
| 502 |
lst_selection.Item(j).select(True)
|
| 503 |
Next j
|
| 504 |
|
| 505 |
swPart.ReorderFeature(NomFeature, nomDossier)
|
| 506 |
End If
|
| 507 |
|
| 508 |
'1 - le dossier est créé ou a déjà été créé.
|
| 509 |
'2 - on redéplace le dossier à la fin.
|
| 510 |
suite:
|
| 511 |
swFeat = swModel.FeatureByPositionReverse(0)
|
| 512 |
swFeat.Select(False)
|
| 513 |
j = 0
|
| 514 |
While Not ok
|
| 515 |
j = j + 1
|
| 516 |
If swFeat.GetTypeName = "ProfileFeature" Or swFeat.GetTypeName = "3DProfileFeature" Then swFeat = swModel.FeatureByPositionReverse(j) Else ok = True
|
| 517 |
End While
|
| 518 |
swPart.ReorderFeature(nomDossier, swFeat.Name)
|
| 519 |
' 3- on déplace le feature dans le dossier
|
| 520 |
|
| 521 |
swPart.ReorderFeature(NomFeature, nomDossier)
|
| 522 |
'swModel.EditRebuild3()
|
| 523 |
|
| 524 |
|
| 525 |
End Sub
|
| 526 |
|
| 527 |
Public Overloads Function trouver(ByRef swface As sldworks.Face2, ByRef tipe As Commun.tipe_e) As Object
|
| 528 |
Dim face As sldworks.Face2
|
| 529 |
|
| 530 |
Select Case tipe
|
| 531 |
Case tipe_e.Volume
|
| 532 |
Dim sface As SlyFaceVolume
|
| 533 |
For Each sface In lst_FaceVolume
|
| 534 |
'If swface Is sface.swFace Then trouver = sface : Exit Function
|
| 535 |
|
| 536 |
For Each face In sface.lst_Faces
|
| 537 |
If face Is swface Then Return sface
|
| 538 |
Next
|
| 539 |
|
| 540 |
Next sface
|
| 541 |
|
| 542 |
Case tipe_e.coque
|
| 543 |
Dim sface As SlyFaceCoque
|
| 544 |
For Each sface In lst_FaceCoque
|
| 545 |
'If swface Is sface.swFace Then trouver = sface : Exit Function
|
| 546 |
For Each face In sface.lst_Faces
|
| 547 |
If face Is swface Then Return sface
|
| 548 |
Next
|
| 549 |
Next sface
|
| 550 |
End Select
|
| 551 |
Return Nothing ' devrait pas passer par ici...
|
| 552 |
End Function
|
| 553 |
|
| 554 |
Public Overloads Function trouver(ByRef swEnt As sldworks.Entity) As Object
|
| 555 |
Dim face As sldworks.Face2
|
| 556 |
Select Case swEnt.GetType()
|
| 557 |
Case swconst.swSelectType_e.swSelFACES
|
| 558 |
Dim swface As sldworks.Face2
|
| 559 |
Dim f As SlyFaceVolume
|
| 560 |
swface = swEnt
|
| 561 |
For Each f In lst_FaceVolume
|
| 562 |
'If f.SwFace Is swface Then Return f
|
| 563 |
For Each face In f.lst_Faces
|
| 564 |
If face Is swface Then Return f
|
| 565 |
Next
|
| 566 |
Next
|
| 567 |
Dim f2 As SlyFaceCoque
|
| 568 |
For Each f2 In lst_FaceCoque
|
| 569 |
'If f2.swFace Is swface Then Return f2
|
| 570 |
For Each face In f2.lst_Faces
|
| 571 |
If face Is swface Then Return f2
|
| 572 |
Next
|
| 573 |
Next
|
| 574 |
|
| 575 |
|
| 576 |
Case swconst.swSelectType_e.swSelEDGES
|
| 577 |
Dim swArete As sldworks.Edge
|
| 578 |
swArete = swEnt
|
| 579 |
Dim test As Object
|
| 580 |
test = Commun.trouver(swArete, tipe_e.Volume)
|
| 581 |
If Not test Is Nothing Then Return test
|
| 582 |
test = Commun.trouver(swArete, tipe_e.coque)
|
| 583 |
If Not test Is Nothing Then Return test
|
| 584 |
test = Commun.trouver(swArete, tipe_e.poutre)
|
| 585 |
If Not test Is Nothing Then Return test
|
| 586 |
|
| 587 |
|
| 588 |
|
| 589 |
Case swconst.swSelectType_e.swSelVERTICES
|
| 590 |
Dim swSommet As sldworks.Vertex
|
| 591 |
swSommet = swEnt
|
| 592 |
|
| 593 |
Dim s1 As SlySommetVolume
|
| 594 |
For Each s1 In lst_SommetVolume
|
| 595 |
If s1.swSommet Is swSommet Then Return s1
|
| 596 |
Next
|
| 597 |
|
| 598 |
Dim s2 As SlySommetCoque
|
| 599 |
For Each s2 In lst_SommetCoque
|
| 600 |
If s2.swSommet Is swSommet Then Return s2
|
| 601 |
Next
|
| 602 |
|
| 603 |
Dim s3 As SlySommetPoutre
|
| 604 |
For Each s3 In lst_sommetPoutre
|
| 605 |
If s3.swSommet Is swSommet Then Return s3
|
| 606 |
Next
|
| 607 |
|
| 608 |
End Select
|
| 609 |
|
| 610 |
MsgBox("Entité non trouvée, dans commun.trouver")
|
| 611 |
Return Nothing
|
| 612 |
End Function
|
| 613 |
|
| 614 |
''' <summary>
|
| 615 |
''' Function qui trouve et retourne le pointeur d'une SlyArete arète si elle existe déjà
|
| 616 |
''' </summary>
|
| 617 |
''' <param name="swArete">L'arète à retrouver</param>
|
| 618 |
''' <param name="tipe">De quel type d'arrète il sagit</param>
|
| 619 |
''' <param name="Genlist">Une option pour accélérer le calcul dans certaines circonstances</param>
|
| 620 |
''' <returns>Le pointeur sur l'entité ou Nothing si elle est pas trouvée</returns>
|
| 621 |
''' <remarks></remarks>
|
| 622 |
Public Overloads Function trouver(ByRef swArete As sldworks.Edge, ByRef tipe As Commun.tipe_e, Optional ByRef Genlist As Boolean = False) As Object
|
| 623 |
|
| 624 |
Select Case tipe
|
| 625 |
Case tipe_e.Volume
|
| 626 |
Dim s As SlyAreteVol
|
| 627 |
For Each s In lst_AreteVolume
|
| 628 |
If swArete Is s.swArete Then Return s
|
| 629 |
Next s
|
| 630 |
|
| 631 |
' ok, si on est ici c'est que l'on a pas trouvé l'arètequi nous intéresse, le pointeur a changé un peu...
|
| 632 |
If Not Genlist Then
|
| 633 |
Dim Testarete As New SuperArete(swArete, True)
|
| 634 |
For Each s In lst_AreteVolume
|
| 635 |
If Testarete.comparer(s.swArete) Then Return s
|
| 636 |
Next s
|
| 637 |
End If
|
| 638 |
|
| 639 |
Case tipe_e.coque
|
| 640 |
Dim sArete As SlyAreteCoque
|
| 641 |
For Each sArete In lst_AreteCoque
|
| 642 |
If swArete Is sArete.swArete Then trouver = sArete : Exit Function
|
| 643 |
Next sArete
|
| 644 |
|
| 645 |
Case tipe_e.poutre
|
| 646 |
For Each sa As SlyAretePoutre In lst_AretePoutre
|
| 647 |
If sa.swArete Is swArete Then Return sa
|
| 648 |
Next
|
| 649 |
|
| 650 |
|
| 651 |
Case tipe_e.MiniPoutre
|
| 652 |
MsgBox("Erreur, on ne devrait plus passer par ici!")
|
| 653 |
'Dim sArete As SlyAretePoutre
|
| 654 |
'Dim i As Integer
|
| 655 |
'For i = 1 To lst_MiniPoutre.Count
|
| 656 |
' sArete = lst_MiniPoutre.Item(i)
|
| 657 |
' If swArete Is sArete.swArete Then trouver = sArete : Exit Function
|
| 658 |
'Next i
|
| 659 |
End Select
|
| 660 |
Return Nothing
|
| 661 |
End Function
|
| 662 |
|
| 663 |
Public Overloads Function trouver(ByRef Arete As SuperArete, ByRef tipe As Commun.tipe_e, Optional ByRef Genlist As Boolean = False) As Object
|
| 664 |
|
| 665 |
Select Case tipe
|
| 666 |
Case tipe_e.Volume
|
| 667 |
' ok, si on est ici c'est que l'on a pas trouvé l'arètequi nous intéresse, le pointeur a changé un peu...
|
| 668 |
If Not Genlist Then
|
| 669 |
Dim s As SlyAreteVol
|
| 670 |
For Each s In lst_AreteVolume
|
| 671 |
If Arete.comparer(s.swArete) Then Return s
|
| 672 |
Next s
|
| 673 |
End If
|
| 674 |
|
| 675 |
Case tipe_e.coque
|
| 676 |
Dim s As SlyAreteCoque
|
| 677 |
For Each s In lst_AreteCoque
|
| 678 |
If Arete.comparer(s.swArete) Then Return s
|
| 679 |
Next s
|
| 680 |
End Select
|
| 681 |
|
| 682 |
Return Nothing
|
| 683 |
End Function
|
| 684 |
|
| 685 |
Public Overloads Function trouver(ByRef swSommet As sldworks.Vertex, ByRef tipe As Commun.tipe_e) As Object
|
| 686 |
|
| 687 |
Select Case tipe
|
| 688 |
Case tipe_e.Volume
|
| 689 |
Dim sSommet As SlySommetVolume
|
| 690 |
For Each sSommet In lst_SommetVolume
|
| 691 |
If swSommet Is sSommet.swSommet Then trouver = sSommet : Exit Function
|
| 692 |
Next sSommet
|
| 693 |
|
| 694 |
Case tipe_e.coque
|
| 695 |
Dim sSommet As SlySommetCoque
|
| 696 |
For Each sSommet In lst_SommetCoque
|
| 697 |
If swSommet Is sSommet.swSommet Then trouver = sSommet : Exit Function
|
| 698 |
Next sSommet
|
| 699 |
|
| 700 |
Case tipe_e.poutre
|
| 701 |
Dim sSommet As SlySommetPoutre
|
| 702 |
For Each sSommet In lst_sommetPoutre
|
| 703 |
If swSommet Is sSommet.swSommet Then trouver = sSommet : Exit Function
|
| 704 |
Next sSommet
|
| 705 |
|
| 706 |
End Select
|
| 707 |
Return Nothing
|
| 708 |
End Function
|
| 709 |
|
| 710 |
Public Sub VideNom()
|
| 711 |
' procédure qui retire le nom écrit sur les entités de solidworks
|
| 712 |
|
| 713 |
Dim vNamedEntity As Object = Nothing
|
| 714 |
Dim swEnt As SldWorks.Entity
|
| 715 |
Dim retval As Boolean
|
| 716 |
Dim i As Integer
|
| 717 |
|
| 718 |
'If MsgBox("Essayer de vider les noms?", MsgBoxStyle.YesNo) = MsgBoxResult.No Then Exit Sub
|
| 719 |
|
| 720 |
Try
|
| 721 |
'MsgBox(swPart.MaterialIdName)
|
| 722 |
vNamedEntity = swPart.GetNamedEntities
|
| 723 |
Catch
|
| 724 |
Dim nb As String
|
| 725 |
Try
|
| 726 |
nb = CStr(swPart.GetNamedEntitiesCount())
|
| 727 |
Catch
|
| 728 |
nb = "??"
|
| 729 |
End Try
|
| 730 |
|
| 731 |
MsgBox("Impossibilité d'obtenir la liste des entités déjà nomées. On continue pareil..." & vbCr & "Il y a " & "??" & " entités qui ont un nom", MsgBoxStyle.Exclamation, "Sérieux problème!")
|
| 732 |
End Try
|
| 733 |
|
| 734 |
|
| 735 |
If IsNothing(vNamedEntity) Then Exit Sub
|
| 736 |
For i = 0 To UBound(vNamedEntity)
|
| 737 |
swEnt = vNamedEntity(i)
|
| 738 |
Debug.Write(swPart.GetEntityName(swEnt))
|
| 739 |
retval = swPart.DeleteEntityName(swEnt)
|
| 740 |
If retval = False Then Debug.Write("Incapable d'effacer l'entité: " & swPart.GetEntityName(swEnt)) ' MsgBox(" Incapable d'effacer l'entité: " & swPart.GetEntityName(swEnt), vbCritical, "Problème dans VideNom()")
|
| 741 |
Next i
|
| 742 |
End Sub
|
| 743 |
|
| 744 |
'function qui transfert les coordonnées du modèle en coodronnées pour le sketch
|
| 745 |
Public Function TransfertModelSketch(ByRef sketch As SldWorks.Sketch, ByRef p() As Double) As Double()
|
| 746 |
Dim MathUtil As SldWorks.MathUtility
|
| 747 |
Dim MathP As SldWorks.MathPoint
|
| 748 |
Dim MathTrans As SldWorks.MathTransform
|
| 749 |
Dim p2() As Double
|
| 750 |
MathUtil = swApp.GetMathUtility
|
| 751 |
MathP = MathUtil.CreatePoint(p)
|
| 752 |
|
| 753 |
MathTrans = sketch.ModelToSketchTransform
|
| 754 |
MathP = MathP.MultiplyTransform(MathTrans)
|
| 755 |
p2 = MathP.ArrayData
|
| 756 |
Return p2
|
| 757 |
End Function
|
| 758 |
|
| 759 |
|
| 760 |
Public Function TransfertSketchToModel(ByRef sketch As SldWorks.Sketch, ByRef p() As Double) As Double()
|
| 761 |
Dim MathUtil As SldWorks.MathUtility
|
| 762 |
Dim MathP As SldWorks.MathPoint
|
| 763 |
Dim MathTrans As SldWorks.MathTransform
|
| 764 |
Dim p2() As Double
|
| 765 |
Dim point(2) As Double
|
| 766 |
Dim vPoint As Object
|
| 767 |
MathUtil = swApp.GetMathUtility
|
| 768 |
point(0) = p(0)
|
| 769 |
point(1) = p(1)
|
| 770 |
If UBound(p) = 1 Then point(2) = 0 Else point(2) = p(2)
|
| 771 |
vPoint = point
|
| 772 |
MathP = MathUtil.CreatePoint(vPoint)
|
| 773 |
|
| 774 |
MathTrans = sketch.ModelToSketchTransform
|
| 775 |
MathTrans = MathTrans.Inverse
|
| 776 |
MathP = MathP.MultiplyTransform(MathTrans)
|
| 777 |
vPoint = MathP.ArrayData
|
| 778 |
p2 = vPoint
|
| 779 |
Return p2
|
| 780 |
End Function
|
| 781 |
|
| 782 |
|
| 783 |
Public Function DistanceMin(ByRef sCoque As SlyFaceCoque, ByRef sVolume As SlyFaceVolume) As Double
|
| 784 |
Dim swFC As SldWorks.Face2
|
| 785 |
Dim swFV As SldWorks.Face2
|
| 786 |
Dim min As Double = 99999999999999
|
| 787 |
Dim temp As Double
|
| 788 |
|
| 789 |
For Each swFC In sCoque.lst_Faces
|
| 790 |
For Each swFV In sVolume.lst_Faces
|
| 791 |
temp = swModel.ClosestDistance(swFC, swFV, Nothing, Nothing)
|
| 792 |
If temp < min Then min = temp
|
| 793 |
Next
|
| 794 |
Next
|
| 795 |
Return min
|
| 796 |
End Function
|
| 797 |
|
| 798 |
|
| 799 |
|
| 800 |
|
| 801 |
Public Overloads Function Distance(ByRef somm As sldworks.Vertex, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
|
| 802 |
Dim vpoints As Object
|
| 803 |
Dim dPoint() As Double
|
| 804 |
Dim temp As Double
|
| 805 |
vpoints = somm.GetPoint()
|
| 806 |
dPoint = vpoints
|
| 807 |
|
| 808 |
temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)
|
| 809 |
Return Math.Sqrt(temp)
|
| 810 |
|
| 811 |
End Function
|
| 812 |
|
| 813 |
Public Overloads Function Distance(ByRef Arete As sldworks.Edge, ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
|
| 814 |
Dim vpoints As Object
|
| 815 |
Dim dPoint() As Double
|
| 816 |
Dim temp As Double
|
| 817 |
vpoints = Arete.GetClosestPointOn(x, y, z)
|
| 818 |
dPoint = vpoints
|
| 819 |
|
| 820 |
temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)
|
| 821 |
|
| 822 |
Return Math.Sqrt(temp)
|
| 823 |
|
| 824 |
End Function
|
| 825 |
|
| 826 |
Public Overloads Function Distance(ByRef Arete As sldworks.Edge, ByRef P() As Double) As Double
|
| 827 |
Dim vpoints As Object
|
| 828 |
Dim dPoint() As Double
|
| 829 |
Dim temp As Double
|
| 830 |
vpoints = Arete.GetClosestPointOn(P(0), P(1), P(2))
|
| 831 |
dPoint = vpoints
|
| 832 |
|
| 833 |
temp = (dPoint(0) - P(0)) * (dPoint(0) - P(0)) + (dPoint(1) - P(1)) * (dPoint(1) - P(1)) + (dPoint(2) - P(2)) * (dPoint(2) - P(2))
|
| 834 |
|
| 835 |
Return Math.Sqrt(temp)
|
| 836 |
|
| 837 |
End Function
|
| 838 |
|
| 839 |
|
| 840 |
Public Overloads Function Distance(ByRef Courbe As sldworks.Curve, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
|
| 841 |
Dim vpoints As Object
|
| 842 |
Dim dPoint() As Double
|
| 843 |
Dim temp As Double
|
| 844 |
vpoints = Courbe.GetClosestPointOn(x, y, z)
|
| 845 |
dPoint = vpoints
|
| 846 |
|
| 847 |
temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)
|
| 848 |
|
| 849 |
Return Math.Sqrt(temp)
|
| 850 |
End Function
|
| 851 |
|
| 852 |
Public Overloads Function Distance(ByRef Face As sldworks.Face2, ByVal xyz() As Double) As Double
|
| 853 |
Return Distance(Face, xyz(0), xyz(1), xyz(2))
|
| 854 |
End Function
|
| 855 |
|
| 856 |
Public Overloads Function Distance(ByRef Face As sldworks.Face2, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
|
| 857 |
Dim vpoints As Object
|
| 858 |
Dim dPoint() As Double
|
| 859 |
Dim temp As Double
|
| 860 |
vpoints = Face.GetClosestPointOn(x, y, z)
|
| 861 |
dPoint = vpoints
|
| 862 |
|
| 863 |
temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)
|
| 864 |
|
| 865 |
Return Math.Sqrt(temp)
|
| 866 |
|
| 867 |
End Function
|
| 868 |
|
| 869 |
Public Overloads Function Distance(ByRef Face As SuperFace, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
|
| 870 |
Dim vpoints As Object
|
| 871 |
Dim dPoint() As Double
|
| 872 |
Dim temp As Double
|
| 873 |
vpoints = Face.SwFace.GetClosestPointOn(x, y, z)
|
| 874 |
dPoint = vpoints
|
| 875 |
|
| 876 |
temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)
|
| 877 |
|
| 878 |
Return Math.Sqrt(temp)
|
| 879 |
|
| 880 |
End Function
|
| 881 |
|
| 882 |
|
| 883 |
Public Overloads Function Distance(ByRef Face As sldworks.Face2, ByRef sommet As sldworks.Vertex) As Double
|
| 884 |
Dim vpoints As Object
|
| 885 |
Dim dPoint() As Double
|
| 886 |
Dim temp As Double
|
| 887 |
Dim x As Double, y As Double, z As Double
|
| 888 |
|
| 889 |
|
| 890 |
vpoints = sommet.GetPoint()
|
| 891 |
dPoint = vpoints
|
| 892 |
x = dPoint(0) : y = dPoint(1) : z = dPoint(2)
|
| 893 |
|
| 894 |
vpoints = Face.GetClosestPointOn(x, y, z)
|
| 895 |
dPoint = vpoints
|
| 896 |
|
| 897 |
temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)
|
| 898 |
|
| 899 |
Return Math.Sqrt(temp)
|
| 900 |
|
| 901 |
End Function
|
| 902 |
|
| 903 |
|
| 904 |
Public Overloads Function distance(ByRef s1 As sldworks.Vertex, ByRef s2 As sldworks.Vertex) As Double
|
| 905 |
|
| 906 |
Dim vpoints As Object
|
| 907 |
Dim dPoint() As Double
|
| 908 |
Dim dPoint2() As Double
|
| 909 |
Dim temp As Double
|
| 910 |
|
| 911 |
vpoints = s1.GetPoint()
|
| 912 |
dPoint = vpoints
|
| 913 |
|
| 914 |
vpoints = s2.GetPoint()
|
| 915 |
dPoint2 = vpoints
|
| 916 |
|
| 917 |
temp = (dPoint(0) - dPoint2(0)) * (dPoint(0) - dPoint2(0)) + (dPoint(1) - dPoint2(1)) * (dPoint(1) - dPoint2(1)) + (dPoint(2) - dPoint2(2)) * (dPoint(2) - dPoint2(2))
|
| 918 |
Return Math.Sqrt(temp)
|
| 919 |
|
| 920 |
End Function
|
| 921 |
|
| 922 |
Public Overloads Function Distance(ByRef X1 As Double, ByRef Y1 As Double, ByRef Z1 As Double, ByRef X2 As Double, ByRef Y2 As Double, ByRef Z2 As Double) As Double
|
| 923 |
Return Math.Sqrt((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2 + (Z2 - Z1) ^ 2)
|
| 924 |
End Function
|
| 925 |
|
| 926 |
|
| 927 |
Public Overloads Function distance(ByRef P1() As Double, ByRef P2() As Double) As Double
|
| 928 |
If Not UBound(P1) = 2 And Not UBound(P2) = 2 Then MsgBox("Cette fonction de distance ne marche qu'en 3D pour l'instant")
|
| 929 |
Return Math.Sqrt((P1(0) - P2(0)) ^ 2 + (P1(1) - P2(1)) ^ 2 + (P1(2) - P2(2)) ^ 2)
|
| 930 |
End Function
|
| 931 |
|
| 932 |
|
| 933 |
Public Overloads Function distance(ByRef P1() As Double, ByRef s2 As sldworks.Vertex) As Double
|
| 934 |
|
| 935 |
Dim vpoints As Object
|
| 936 |
Dim dPoint() As Double
|
| 937 |
Dim dPoint2() As Double
|
| 938 |
Dim temp As Double
|
| 939 |
|
| 940 |
|
| 941 |
dPoint = P1
|
| 942 |
|
| 943 |
vpoints = s2.GetPoint()
|
| 944 |
dPoint2 = vpoints
|
| 945 |
|
| 946 |
temp = (dPoint(0) - dPoint2(0)) * (dPoint(0) - dPoint2(0)) + (dPoint(1) - dPoint2(1)) * (dPoint(1) - dPoint2(1)) + (dPoint(2) - dPoint2(2)) * (dPoint(2) - dPoint2(2))
|
| 947 |
Return Math.Sqrt(temp)
|
| 948 |
|
| 949 |
End Function
|
| 950 |
|
| 951 |
Public Overloads Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetCoque) As Double
|
| 952 |
Return Distance(s1.swSommet, s2.swSommet)
|
| 953 |
End Function
|
| 954 |
|
| 955 |
Public Overloads Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetVolume) As Double
|
| 956 |
Return Distance(s1.swSommet, s2.swSommet)
|
| 957 |
End Function
|
| 958 |
|
| 959 |
''' <summary>
|
| 960 |
''' Distance entre un point d'esquisse et un sommet
|
| 961 |
''' </summary>
|
| 962 |
''' <param name="swPoint"></param>
|
| 963 |
''' <param name="SwSommet"></param>
|
| 964 |
''' <returns></returns>
|
| 965 |
''' <remarks></remarks>
|
| 966 |
Public Overloads Function Distance(ByRef swPoint As sldworks.SketchPoint, ByRef SwSommet As sldworks.Vertex) As Double
|
| 967 |
Dim P(2) As Double
|
| 968 |
P(0) = swPoint.X : P(1) = swPoint.Y : P(2) = swPoint.Z
|
| 969 |
P = Commun.TransfertModelSketch(swPoint.GetSketch, P)
|
| 970 |
Dim esom As New SuperSommet(SwSommet, True)
|
| 971 |
Return Math.Sqrt((esom.X - P(0)) ^ 2 + (esom.Y - P(1)) ^ 2 + (esom.Z - P(2)) ^ 2)
|
| 972 |
|
| 973 |
End Function
|
| 974 |
|
| 975 |
|
| 976 |
Public Overloads Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetPoutre) As Double
|
| 977 |
Return Distance(s1.swSommet, s2.swSommet)
|
| 978 |
End Function
|
| 979 |
|
| 980 |
Public Function GetLongueurArete(ByRef swArete As SldWorks.Edge) As Double
|
| 981 |
Dim swCourbe As SldWorks.Curve
|
| 982 |
Dim temp As Object
|
| 983 |
Dim T1 As Double, T2 As Double
|
| 984 |
Dim sommet As SldWorks.Vertex
|
| 985 |
Dim point As Object
|
| 986 |
|
| 987 |
swCourbe = swArete.GetCurve
|
| 988 |
|
| 989 |
sommet = swArete.GetStartVertex()
|
| 990 |
|
| 991 |
If sommet IsNot Nothing Then
|
| 992 |
point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T1 = temp(0)
|
| 993 |
sommet = swArete.GetEndVertex() : point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T2 = temp(0)
|
| 994 |
Return swCourbe.GetLength2(T1, T2)
|
| 995 |
|
| 996 |
Else
|
| 997 |
'l'arète est fermée.
|
| 998 |
Dim params() As Double
|
| 999 |
If swCourbe.IsCircle Then
|
| 1000 |
params = swCourbe.CircleParams
|
| 1001 |
Return params(7) * Pi * 2
|
| 1002 |
End If
|
| 1003 |
MsgBox("On demande la longueur d'une courbe fermée qui n'est pas un cercle... ce n'est pas encore programmé car ça ne devrait pas arriver.")
|
| 1004 |
End If
|
| 1005 |
|
| 1006 |
End Function
|
| 1007 |
|
| 1008 |
|
| 1009 |
''' <summary>
|
| 1010 |
''' Function qui retourne le paramètreT du milieu de l'arète
|
| 1011 |
''' </summary>
|
| 1012 |
''' <param name="swSrete">L'arète en question</param>
|
| 1013 |
''' <returns>Le paramètre T de l acourbe</returns>
|
| 1014 |
''' <remarks>Si la courbe est fermée, la fonction retourne auqnd ême le T milieu. i.e. T = pi</remarks>
|
| 1015 |
Public Function GetTMilieu(ByRef swArete As SldWorks.Edge) As Double
|
| 1016 |
Dim swCourbe As SldWorks.Curve
|
| 1017 |
Dim temp As Object
|
| 1018 |
Dim T1 As Double, T2 As Double
|
| 1019 |
Dim sommet As SldWorks.Vertex
|
| 1020 |
Dim point As Object
|
| 1021 |
|
| 1022 |
swCourbe = swArete.GetCurve
|
| 1023 |
|
| 1024 |
sommet = swArete.GetStartVertex()
|
| 1025 |
|
| 1026 |
If sommet IsNot Nothing Then
|
| 1027 |
point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T1 = temp(0)
|
| 1028 |
sommet = swArete.GetEndVertex() : point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T2 = temp(0)
|
| 1029 |
Return (T1 + T2) / 2
|
| 1030 |
|
| 1031 |
Else
|
| 1032 |
'l'arète est fermée.
|
| 1033 |
If swCourbe.IsCircle Then
|
| 1034 |
Return Pi
|
| 1035 |
End If
|
| 1036 |
MsgBox("On demande la longueur d'une courbe fermée qui n'est pas un cercle... ce n'est pas encore programmé car ça ne devrait pas arriver.")
|
| 1037 |
End If
|
| 1038 |
|
| 1039 |
|
| 1040 |
|
| 1041 |
End Function
|
| 1042 |
|
| 1043 |
'Procédure qui repère les arètes avec des atributs et leur met une couleur
|
| 1044 |
Public Sub ColorerAretes()
|
| 1045 |
' on fait le tour des features pour avoir les poutres et les coques
|
| 1046 |
Dim feat As SldWorks.Feature
|
| 1047 |
Dim vSupprime As Object
|
| 1048 |
Dim bSupprime As Boolean
|
| 1049 |
Dim ent As SldWorks.Entity
|
| 1050 |
Dim attr As SldWorks.Attribute
|
| 1051 |
Dim swArete As SldWorks.Edge
|
| 1052 |
'RealConstant.RegisterAttribut()
|
| 1053 |
'RealConstant.RCCode.RegisterAttribut()
|
| 1054 |
|
| 1055 |
swModel.EditRebuild3()
|
| 1056 |
|
| 1057 |
feat = swPart.FirstFeature
|
| 1058 |
|
| 1059 |
Do While Not feat Is Nothing
|
| 1060 |
|
| 1061 |
vSupprime = feat.IsSuppressed
|
| 1062 |
bSupprime = CBool(vSupprime)
|
| 1063 |
If Not bSupprime Then ' on vérifie que l'entité est pas supprimée
|
| 1064 |
|
| 1065 |
Select Case feat.GetTypeName
|
| 1066 |
Case "CompositeCurve", "3DSplineCurve", "Helix" 'le feature est une courbe libre
|
| 1067 |
|
| 1068 |
Dim refCourbe As SldWorks.ReferenceCurve
|
| 1069 |
|
| 1070 |
refCourbe = feat.GetSpecificFeature2
|
| 1071 |
swArete = refCourbe.GetFirstSegment
|
| 1072 |
Do While Not swArete Is Nothing
|
| 1073 |
Try
|
| 1074 |
ent = swArete
|
| 1075 |
attr = ent.FindAttribute(Intersections.DefAttrRCP1, 0)
|
| 1076 |
If Left(attr.GetName, 4) = "Mini" Then swArete.Display(2, 1, 0, 1, True) Else swArete.Display(2, 0, 1, 0, True)
|
| 1077 |
Catch ex As Exception
|
| 1078 |
|
| 1079 |
End Try
|
| 1080 |
|
| 1081 |
swArete = Nothing
|
| 1082 |
swArete = refCourbe.GetNextSegment
|
| 1083 |
Loop
|
| 1084 |
End Select
|
| 1085 |
|
| 1086 |
End If ' fin du if sur la suppression du feature
|
| 1087 |
feat = feat.GetNextFeature
|
| 1088 |
Loop
|
| 1089 |
End Sub
|
| 1090 |
|
| 1091 |
' procédure de débuggage qui place un point là où on le demande. (avec un sketch3D)
|
| 1092 |
Public Overloads Sub MettreUnPoint(ByRef x As Double, ByRef y As Double, ByRef z As Double, Optional ByVal Selection As Boolean = False)
|
| 1093 |
Dim point As sldworks.SketchPoint
|
| 1094 |
swModel.Insert3DSketch2(True)
|
| 1095 |
point = swModel.CreatePoint2(x, y, z)
|
| 1096 |
swModel.Insert3DSketch2(False)
|
| 1097 |
'swModel.EditRebuild3()
|
| 1098 |
If Selection Then
|
| 1099 |
point.Select2(False, 0)
|
| 1100 |
End If
|
| 1101 |
End Sub
|
| 1102 |
|
| 1103 |
Public Overloads Function MettreUnPoint(ByRef Plan As sldworks.RefPlane, ByRef x As Double, ByRef y As Double, ByRef z As Double) As sldworks.SketchPoint
|
| 1104 |
Dim swent As sldworks.Entity
|
| 1105 |
Dim p(2) As Double
|
| 1106 |
p(0) = x
|
| 1107 |
p(1) = y
|
| 1108 |
p(2) = z
|
| 1109 |
swent = Plan
|
| 1110 |
swent.Select4(False, Nothing)
|
| 1111 |
swModel.InsertSketch2(True)
|
| 1112 |
p = Commun.TransfertModelSketch(swModel.GetActiveSketch2(), p)
|
| 1113 |
MettreUnPoint = swModel.CreatePoint2(p(0), p(1), p(2))
|
| 1114 |
swModel.InsertSketch2(False)
|
| 1115 |
swModel.EditRebuild3()
|
| 1116 |
End Function
|
| 1117 |
|
| 1118 |
Public Overloads Function MettreUneLigne(ByRef Plan As sldworks.RefPlane, ByRef x1 As Double, ByRef y1 As Double, ByRef z1 As Double, ByRef x2 As Double, ByRef y2 As Double, ByRef z2 As Double) As sldworks.SketchSegment
|
| 1119 |
Dim swent As sldworks.Entity
|
| 1120 |
Dim p(2) As Double, p2(2) As Double
|
| 1121 |
p(0) = x1 : p(1) = y1 : p(2) = z1
|
| 1122 |
p2(0) = x2 : p2(1) = y2 : p2(2) = z2
|
| 1123 |
swent = Plan
|
| 1124 |
swent.Select4(False, Nothing)
|
| 1125 |
swModel.InsertSketch2(True)
|
| 1126 |
p = Commun.TransfertModelSketch(swModel.GetActiveSketch2(), p)
|
| 1127 |
p2 = Commun.TransfertModelSketch(swModel.GetActiveSketch2(), p2)
|
| 1128 |
MettreUneLigne = swModel.CreateLine2(p(0), p(1), p(2), p2(0), p2(1), p2(2))
|
| 1129 |
swModel.InsertSketch2(False)
|
| 1130 |
swModel.EditRebuild3()
|
| 1131 |
End Function
|
| 1132 |
|
| 1133 |
Public Overloads Function MettreUneLigne(ByRef face As sldworks.Face2, ByRef x1 As Double, ByRef y1 As Double, ByRef z1 As Double, ByRef x2 As Double, ByRef y2 As Double, ByRef z2 As Double) As sldworks.SketchSegment
|
| 1134 |
Dim swent As sldworks.Entity
|
| 1135 |
Dim p(2) As Double, p2(2) As Double
|
| 1136 |
p(0) = x1 : p(1) = y1 : p(2) = z1
|
| 1137 |
p2(0) = x2 : p2(1) = y2 : p2(2) = z2
|
| 1138 |
swent = face
|
| 1139 |
swent.Select4(False, Nothing)
|
| 1140 |
swModel.InsertSketch2(True)
|
| 1141 |
p = Commun.TransfertModelSketch(swModel.GetActiveSketch2(), p)
|
| 1142 |
p2 = Commun.TransfertModelSketch(swModel.GetActiveSketch2(), p2)
|
| 1143 |
MettreUneLigne = swModel.CreateLine2(p(0), p(1), p(2), p2(0), p2(1), p2(2))
|
| 1144 |
swModel.InsertSketch2(False)
|
| 1145 |
swModel.EditRebuild3()
|
| 1146 |
End Function
|
| 1147 |
|
| 1148 |
''' <summary>
|
| 1149 |
''' Créé une ligne dans un sketch selon ses 2 points d'extrémités
|
| 1150 |
''' </summary>
|
| 1151 |
''' <param name="P"></param>
|
| 1152 |
''' <param name="P2"></param>
|
| 1153 |
''' <remarks></remarks>
|
| 1154 |
Public Overloads Sub MettreUneLigne(ByRef P() As Double, ByRef P2() As Double)
|
| 1155 |
swModel.Insert3DSketch2(False)
|
| 1156 |
swModel.CreateLine2(P(0), P(1), P(2), P2(0), P2(1), P2(2))
|
| 1157 |
swModel.Insert3DSketch2(False)
|
| 1158 |
swModel.EditRebuild3()
|
| 1159 |
End Sub
|
| 1160 |
|
| 1161 |
|
| 1162 |
|
| 1163 |
|
| 1164 |
Public Sub EffacerAnnoEtCoord()
|
| 1165 |
Dim anno As sldworks.Annotation
|
| 1166 |
Dim ent As sldworks.Entity
|
| 1167 |
Dim prochainAnno As sldworks.Annotation
|
| 1168 |
|
| 1169 |
anno = swModel.GetFirstAnnotation2
|
| 1170 |
|
| 1171 |
Do While Not anno Is Nothing
|
| 1172 |
anno.Select(False)
|
| 1173 |
prochainAnno = anno.GetNext3()
|
| 1174 |
swModel.EditDelete()
|
| 1175 |
anno = prochainAnno
|
| 1176 |
Loop
|
| 1177 |
|
| 1178 |
|
| 1179 |
' parcours des features pour éliminer les Points3
|
| 1180 |
Dim feat As sldworks.Feature
|
| 1181 |
Dim nextfeat As sldworks.Feature
|
| 1182 |
feat = swPart.FirstFeature
|
| 1183 |
|
| 1184 |
Do While Not feat Is Nothing
|
| 1185 |
If feat.GetTypeName = "CoordSys" Then
|
| 1186 |
nextfeat = feat.GetNextFeature
|
| 1187 |
ent = feat
|
| 1188 |
ent.Select2(False, Nothing)
|
| 1189 |
swModel.EditDelete()
|
| 1190 |
feat = nextfeat
|
| 1191 |
Else
|
| 1192 |
feat = feat.GetNextFeature()
|
| 1193 |
End If
|
| 1194 |
Loop
|
| 1195 |
|
| 1196 |
|
| 1197 |
End Sub
|
| 1198 |
|
| 1199 |
Sub MettreAttributPourFaceInterne(ByRef swFaceInterne As sldworks.Face2)
|
| 1200 |
' Sub qui place l'attribut de faceinterne sur une face
|
| 1201 |
Dim attr As sldworks.Attribute
|
| 1202 |
Dim swent As sldworks.Entity
|
| 1203 |
Static no As Integer = 1
|
| 1204 |
Dim nom2 As String
|
| 1205 |
|
| 1206 |
nom2 = "FaceInterne #" & no
|
| 1207 |
swent = swFaceInterne
|
| 1208 |
attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
|
| 1209 |
|
| 1210 |
If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFaceInterne, nom2, 0, 2) ' 0 = swThisconfig
|
| 1211 |
|
| 1212 |
While attr Is Nothing
|
| 1213 |
nom2 = "FaceInterne" & CStr(no)
|
| 1214 |
attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFaceInterne, nom2, 0, 0)
|
| 1215 |
no += 1
|
| 1216 |
End While
|
| 1217 |
GererDossiers("FaceInternes", nom2)
|
| 1218 |
no += 1
|
| 1219 |
End Sub
|
| 1220 |
|
| 1221 |
Private Function Ignorer(ByRef swArete As sldworks.Edge) As Boolean
|
| 1222 |
Dim attr As sldworks.Attribute
|
| 1223 |
Dim SwEnt As sldworks.Entity
|
| 1224 |
Dim p As sldworks.Parameter
|
| 1225 |
SwEnt = swArete
|
| 1226 |
attr = SwEnt.FindAttribute(DefAttrRCP1, 0)
|
| 1227 |
If attr Is Nothing Then Return False
|
| 1228 |
p = attr.GetParameter("D1")
|
| 1229 |
If p.GetDoubleValue = -9 Then Return True Else Return False
|
| 1230 |
End Function
|
| 1231 |
|
| 1232 |
Public Sub GetMidPointSegment(ByVal seg As sldworks.SketchSegment, ByRef x As Double, ByRef y As Double, ByRef z As Double)
|
| 1233 |
Dim curve As sldworks.Curve
|
| 1234 |
Dim start As Double
|
| 1235 |
Dim pend As Double
|
| 1236 |
Dim isClosed As Boolean
|
| 1237 |
Dim isPeriodic As Boolean
|
| 1238 |
Dim milieu As Double
|
| 1239 |
Dim vXYZ As Object
|
| 1240 |
Dim xyz(2) As Double
|
| 1241 |
|
| 1242 |
curve = seg.GetCurve
|
| 1243 |
curve.GetEndParams(start, pend, isClosed, isPeriodic)
|
| 1244 |
|
| 1245 |
milieu = (pend + start) / 2
|
| 1246 |
|
| 1247 |
vXYZ = curve.Evaluate(milieu)
|
| 1248 |
|
| 1249 |
xyz = vXYZ
|
| 1250 |
|
| 1251 |
x = xyz(0) : y = xyz(1) : z = xyz(2)
|
| 1252 |
|
| 1253 |
End Sub
|
| 1254 |
|
| 1255 |
Public Sub SelectFaceByName(ByVal Nom As String, Optional ByVal append As Boolean = False)
|
| 1256 |
Dim swent As sldworks.Entity
|
| 1257 |
swent = swPart.GetEntityByName(Nom, swconst.swSelectType_e.swSelFACES)
|
| 1258 |
swent.Select4(append, Nothing)
|
| 1259 |
End Sub
|
| 1260 |
|
| 1261 |
Public Sub SelectAreteByName(ByVal Nom As String, Optional ByVal append As Boolean = False)
|
| 1262 |
Dim swent As sldworks.Entity
|
| 1263 |
swent = swPart.GetEntityByName(Nom, swconst.swSelectType_e.swSelEDGES)
|
| 1264 |
swent.Select4(append, Nothing)
|
| 1265 |
End Sub
|
| 1266 |
|
| 1267 |
Public Sub SelectSommetByName(ByVal Nom As String, Optional ByVal append As Boolean = False)
|
| 1268 |
Dim swent As sldworks.Entity
|
| 1269 |
swent = swPart.GetEntityByName(Nom, swconst.swSelectType_e.swSelVERTICES)
|
| 1270 |
swent.Select4(append, Nothing)
|
| 1271 |
End Sub
|
| 1272 |
|
| 1273 |
Public Function DessineCourbe(ByRef curve As sldworks.Curve) As sldworks.SketchSegment
|
| 1274 |
Dim modeler As sldworks.Modeler
|
| 1275 |
Dim vp1 As Object : Dim P1() As Double
|
| 1276 |
Dim vp2 As Object : Dim P2() As Double
|
| 1277 |
Dim dir(2) As Double
|
| 1278 |
Dim sketchseg As sldworks.SketchSegment = Nothing
|
| 1279 |
Dim i As Integer
|
| 1280 |
Dim Tmax As Double, Tmin As Double
|
| 1281 |
Dim ajout As Double
|
| 1282 |
|
| 1283 |
Dim isPeriodic As Boolean : Dim isClosed As Boolean
|
| 1284 |
|
| 1285 |
If curve.IsTrimmedCurve Then
|
| 1286 |
If curve.IsLine Then
|
| 1287 |
swModel.Insert3DSketch2(False)
|
| 1288 |
curve.GetEndParams(Tmin, Tmax, isClosed, isPeriodic)
|
| 1289 |
vp1 = curve.Evaluate(Tmin)
|
| 1290 |
vp2 = curve.Evaluate(Tmax)
|
| 1291 |
sketchseg = swModel.CreateLine2(vp1(0), vp1(1), vp1(2), vp2(0), vp2(1), vp2(2))
|
| 1292 |
swModel.Insert3DSketch2(False)
|
| 1293 |
Return sketchseg
|
| 1294 |
End If
|
| 1295 |
|
| 1296 |
Else
|
| 1297 |
curve.GetEndParams(Tmin, Tmax, isClosed, isPeriodic)
|
| 1298 |
modeler = swApp.GetModeler
|
| 1299 |
swModel.Insert3DSketch2(False)
|
| 1300 |
ajout = (Tmax - Tmin) / 100
|
| 1301 |
vp1 = curve.Evaluate(Tmin) : P1 = vp1
|
| 1302 |
For i = 1 To 100
|
| 1303 |
vp2 = curve.Evaluate(Tmin + i * ajout) : P2 = vp2
|
| 1304 |
sketchseg = swModel.CreateLine2(P1(0), P1(1), P1(2), P2(0), P2(1), P2(2))
|
| 1305 |
P1 = P2
|
| 1306 |
Next i
|
| 1307 |
swModel.Insert3DSketch2(False)
|
| 1308 |
|
| 1309 |
'modeler = swApp.GetModeler
|
| 1310 |
'For i = 1 To 100
|
| 1311 |
' vp2 = curve.Evaluate(Tmin + i * ajout)
|
| 1312 |
' modeler.CreateLine(vp1, vp2)
|
| 1313 |
' vp1 = vp2
|
| 1314 |
'Next i
|
| 1315 |
Return sketchseg
|
| 1316 |
End If
|
| 1317 |
Return Nothing
|
| 1318 |
End Function
|
| 1319 |
|
| 1320 |
Function AngleEntre2Faces(ByRef swface1 As sldworks.Face2, ByRef swface2 As sldworks.Face2, ByRef P() As Double) As Double
|
| 1321 |
' function qui trouve l'angle entre 2 faces au point spécifié...
|
| 1322 |
Return AngleEntre2Faces(swface1, swface2, P(0), P(1), P(2))
|
| 1323 |
End Function
|
| 1324 |
|
| 1325 |
Function AngleEntre2Faces(ByRef swface1 As sldworks.Face2, ByRef swface2 As sldworks.Face2, ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
|
| 1326 |
' function qui trouve l'angle entre 2 faces au point spécifié...
|
| 1327 |
Dim swSurf As sldworks.Surface
|
| 1328 |
Dim retval As Object
|
| 1329 |
Dim Normale1(2) As Double
|
| 1330 |
Dim Normale2(2) As Double
|
| 1331 |
|
| 1332 |
swSurf = swface1.GetSurface
|
| 1333 |
retval = swSurf.EvaluateAtPoint(x, y, z)
|
| 1334 |
Normale1(0) = retval(0) : Normale1(1) = retval(1) : Normale1(2) = retval(2)
|
| 1335 |
|
| 1336 |
swSurf = swface2.GetSurface
|
| 1337 |
retval = swSurf.EvaluateAtPoint(x, y, z)
|
| 1338 |
Normale2(0) = retval(0) : Normale2(1) = retval(1) : Normale2(2) = retval(2)
|
| 1339 |
|
| 1340 |
Return Outils_Math.Angle2Vecteurs(Normale1, Normale2)
|
| 1341 |
End Function
|
| 1342 |
|
| 1343 |
|
| 1344 |
|
| 1345 |
|
| 1346 |
|
| 1347 |
Public Sub Test()
|
| 1348 |
' se déclenche quand on apuie sur le bouton 4
|
| 1349 |
|
| 1350 |
Dim lst As New Collections.ObjectModel.Collection(Of sldworks.Vertex)
|
| 1351 |
|
| 1352 |
Intersections.RegisterAttribut()
|
| 1353 |
|
| 1354 |
swModel.EditRebuild3()
|
| 1355 |
' on fait le tour des features pour avoir les poutres et les coques
|
| 1356 |
Dim feat As sldworks.Feature
|
| 1357 |
Dim vSupprime As Object
|
| 1358 |
Dim bSupprime As Boolean
|
| 1359 |
Dim attr As sldworks.Attribute
|
| 1360 |
Dim swArete As sldworks.Edge
|
| 1361 |
Dim swSommet1 As sldworks.Vertex
|
| 1362 |
Dim swSommet2 As sldworks.Vertex
|
| 1363 |
|
| 1364 |
feat = swPart.FirstFeature
|
| 1365 |
|
| 1366 |
Do While Not feat Is Nothing
|
| 1367 |
|
| 1368 |
vSupprime = feat.IsSuppressed
|
| 1369 |
bSupprime = CBool(vSupprime)
|
| 1370 |
If Not bSupprime Then ' on vérifie que l'entité est pas supprimée
|
| 1371 |
|
| 1372 |
Select Case feat.GetTypeName
|
| 1373 |
Case "CompositeCurve", "3DSplineCurve", "Helix" 'le feature est une courbe libre
|
| 1374 |
|
| 1375 |
Dim refCourbe As sldworks.ReferenceCurve
|
| 1376 |
refCourbe = feat.GetSpecificFeature2
|
| 1377 |
swArete = refCourbe.GetFirstSegment
|
| 1378 |
Do While Not swArete Is Nothing
|
| 1379 |
|
| 1380 |
If (Not Ignorer(swArete)) Then
|
| 1381 |
|
| 1382 |
swSommet1 = swArete.GetStartVertex
|
| 1383 |
lst.Add(swSommet1)
|
| 1384 |
|
| 1385 |
If IsNothing(swSommet1) Then
|
| 1386 |
'MsgBox("On a une courbe sans sommet")
|
| 1387 |
Else
|
| 1388 |
swSommet2 = swArete.GetEndVertex
|
| 1389 |
lst.Add(swSommet2)
|
| 1390 |
End If
|
| 1391 |
End If
|
| 1392 |
|
| 1393 |
swArete = Nothing
|
| 1394 |
swArete = refCourbe.GetNextSegment
|
| 1395 |
|
| 1396 |
Loop
|
| 1397 |
|
| 1398 |
Case Else ' n'est pas un feature intéressant...
|
| 1399 |
' rien
|
| 1400 |
End Select
|
| 1401 |
End If ' fin du if sur la suppression du feature
|
| 1402 |
feat = feat.GetNextFeature
|
| 1403 |
Loop
|
| 1404 |
|
| 1405 |
|
| 1406 |
Dim swEnt As sldworks.Entity
|
| 1407 |
For Each s As sldworks.Vertex In lst
|
| 1408 |
swEnt = s
|
| 1409 |
attr = swEnt.FindAttribute(DefAttrDoublon, 0)
|
| 1410 |
If Not attr Is Nothing Then
|
| 1411 |
Dim p As sldworks.Parameter = attr.GetParameter("Maitre")
|
| 1412 |
MsgBox(p.GetStringValue)
|
| 1413 |
End If
|
| 1414 |
Next
|
| 1415 |
|
| 1416 |
End Sub
|
| 1417 |
|
| 1418 |
|
| 1419 |
''' <summary>
|
| 1420 |
''' Sub qui dessine avec des corps temporaires le sens des arètes et la normale des faces.
|
| 1421 |
''' </summary>
|
| 1422 |
''' <remarks></remarks>
|
| 1423 |
Public Sub DessinerSensAretesEtNormaleFace()
|
| 1424 |
|
| 1425 |
Try
|
| 1426 |
Dim lst_fleches_Face As New Collections.Generic.List(Of sldworks.Body2)
|
| 1427 |
Dim lst_fleches_Arete As New Collections.Generic.List(Of sldworks.Body2)
|
| 1428 |
Dim lst_fleches_CoArete As New Collections.Generic.List(Of sldworks.Body2)
|
| 1429 |
Dim selmgr As sldworks.SelectionMgr = swModel.SelectionManager
|
| 1430 |
Dim ext As sldworks.ModelDocExtension = swModel.Extension
|
| 1431 |
Dim normale(2) As Double
|
| 1432 |
|
| 1433 |
Dim swMprop As sldworks.MassProperty = swModel.Extension.CreateMassProperty
|
| 1434 |
Dim volume As Double = swMprop.Volume
|
| 1435 |
Dim surface As Double = swMprop.SurfaceArea
|
| 1436 |
Dim Grosseur As Double = (volume / surface) / 4
|
| 1437 |
Dim centreX, centreY, centreZ As Double
|
| 1438 |
Dim Dx, Dy, Dz As Double
|
| 1439 |
Dim D(2) As Double
|
| 1440 |
Dim bod As sldworks.Body2
|
| 1441 |
|
| 1442 |
' pour dessiner les normales
|
| 1443 |
Dim swFace As sldworks.Face2
|
| 1444 |
Dim swEnt As sldworks.Entity
|
| 1445 |
|
| 1446 |
For ff As Integer = 1 To selmgr.GetSelectedObjectCount
|
| 1447 |
If selmgr.GetSelectedObjectType3(ff, -1) = swconst.swSelectType_e.swSelFACES Then
|
| 1448 |
swEnt = selmgr.GetSelectedObject6(ff, -1)
|
| 1449 |
swFace = swEnt
|
| 1450 |
Else
|
| 1451 |
Continue For
|
| 1452 |
End If
|
| 1453 |
|
| 1454 |
Dim F As New SuperFace(swFace, True)
|
| 1455 |
Dim Umin As Double, Umax As Double, Vmin As Double, Vmax As Double, U As Double, V As Double
|
| 1456 |
Dim i As Integer, j As Integer, Uinc As Double, Vinc As Double
|
| 1457 |
|
| 1458 |
|
| 1459 |
F.UVMinMax(Umin, Umax, Vmin, Vmax)
|
| 1460 |
V = Vmin
|
| 1461 |
U = Umin
|
| 1462 |
Uinc = (Umax - Umin) / 5
|
| 1463 |
Vinc = (Vmax - Vmin) / 5
|
| 1464 |
|
| 1465 |
For i = 1 To 4
|
| 1466 |
U += Uinc
|
| 1467 |
V = Vmin
|
| 1468 |
For j = 1 To 4
|
| 1469 |
V += Vinc
|
| 1470 |
|
| 1471 |
If F.Evaluer(U, V, centreX, centreY, centreZ) Then
|
| 1472 |
normale = F.Normale(centreX, centreY, centreZ)
|
| 1473 |
Dx = normale(0) : Dy = normale(1) : Dz = normale(2)
|
| 1474 |
bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, Dx, Dy, Dz, 255, 0, 0, Grosseur)
|
| 1475 |
lst_fleches_Face.Add(bod)
|
| 1476 |
End If
|
| 1477 |
Next j
|
| 1478 |
Next i
|
| 1479 |
|
| 1480 |
|
| 1481 |
|
| 1482 |
' mémoriser les points des aretes
|
| 1483 |
'Dim vEdge As Object = swFace.GetEdges
|
| 1484 |
Dim loope As sldworks.Loop2 = swFace.GetFirstLoop
|
| 1485 |
|
| 1486 |
While loope IsNot Nothing
|
| 1487 |
|
| 1488 |
Dim CoArete As sldworks.CoEdge = loope.GetFirstCoEdge
|
| 1489 |
|
| 1490 |
For coa As Integer = 0 To loope.GetEdgeCount - 1
|
| 1491 |
|
| 1492 |
Dim swArete As sldworks.Edge
|
| 1493 |
swArete = CoArete.GetEdge
|
| 1494 |
'For Each swArete As sldworks.Edge In vEdge
|
| 1495 |
Dim a As New SuperArete(swArete, True)
|
| 1496 |
Dim Tmin As Double, Tmax As Double
|
| 1497 |
Dim incT As Double, T As Double
|
| 1498 |
|
| 1499 |
Tmax = a.GetTMax()
|
| 1500 |
Tmin = a.GetTMin
|
| 1501 |
incT = (Tmax - Tmin) / 5
|
| 1502 |
|
| 1503 |
T = Tmin
|
| 1504 |
a.Evaluer(T, centreX, centreY, centreZ)
|
| 1505 |
D = a.GetTangence(T)
|
| 1506 |
bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 2)
|
| 1507 |
lst_fleches_Arete.Add(bod)
|
| 1508 |
|
| 1509 |
T = Tmin + 1 * incT
|
| 1510 |
a.Evaluer(T, centreX, centreY, centreZ)
|
| 1511 |
D = a.GetTangence(T)
|
| 1512 |
bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 2)
|
| 1513 |
lst_fleches_Arete.Add(bod)
|
| 1514 |
|
| 1515 |
T = Tmin + 2 * incT
|
| 1516 |
a.Evaluer(T, centreX, centreY, centreZ)
|
| 1517 |
D = a.GetTangence(T)
|
| 1518 |
bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 2)
|
| 1519 |
lst_fleches_Arete.Add(bod)
|
| 1520 |
|
| 1521 |
|
| 1522 |
T = Tmin + 3 * incT
|
| 1523 |
a.Evaluer(T, centreX, centreY, centreZ)
|
| 1524 |
D = a.GetTangence(T)
|
| 1525 |
If Not CoArete.GetSense() Then D = Outils_Math.InverserVecteur(D)
|
| 1526 |
bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 4)
|
| 1527 |
lst_fleches_CoArete.Add(bod)
|
| 1528 |
|
| 1529 |
T = Tmin + 4 * incT
|
| 1530 |
a.Evaluer(T, centreX, centreY, centreZ)
|
| 1531 |
D = a.GetTangence(T)
|
| 1532 |
If Not CoArete.GetSense() Then D = Outils_Math.InverserVecteur(D)
|
| 1533 |
bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 4)
|
| 1534 |
lst_fleches_CoArete.Add(bod)
|
| 1535 |
|
| 1536 |
CoArete = CoArete.GetNext
|
| 1537 |
Next coa ' coarete
|
| 1538 |
loope = loope.GetNext
|
| 1539 |
End While ' loope
|
| 1540 |
|
| 1541 |
Next ff
|
| 1542 |
|
| 1543 |
|
| 1544 |
For Each body As sldworks.Body2 In lst_fleches_Face
|
| 1545 |
body.Display3(swPart, 1, 0)
|
| 1546 |
Next
|
| 1547 |
|
| 1548 |
For Each body As sldworks.Body2 In lst_fleches_Arete
|
| 1549 |
body.Display3(swPart, RGB(255, 0, 0), 0)
|
| 1550 |
Next
|
| 1551 |
|
| 1552 |
For Each body As sldworks.Body2 In lst_fleches_CoArete
|
| 1553 |
body.Display3(swPart, RGB(200, 0, 200), 0)
|
| 1554 |
Next
|
| 1555 |
|
| 1556 |
Catch ex As Exception
|
| 1557 |
swApp.SendMsgToUser2("Ça n'a pas marché!", swconst.swMessageBoxIcon_e.swMbInformation, swconst.swMessageBoxBtn_e.swMbOk)
|
| 1558 |
End Try
|
| 1559 |
|
| 1560 |
|
| 1561 |
|
| 1562 |
End Sub
|
| 1563 |
|
| 1564 |
|
| 1565 |
''' <summary>
|
| 1566 |
''' Dessine une flèche temporaire (temp. Body)
|
| 1567 |
''' </summary>
|
| 1568 |
''' <param name="CentreX"></param>
|
| 1569 |
''' <param name="centreY"></param>
|
| 1570 |
''' <param name="centreZ"></param>
|
| 1571 |
''' <param name="Dx"></param>
|
| 1572 |
''' <param name="Dy"></param>
|
| 1573 |
''' <param name="Dz"></param>
|
| 1574 |
''' <param name="Rouge"></param>
|
| 1575 |
''' <param name="Vert"></param>
|
| 1576 |
''' <param name="Bleu"></param>
|
| 1577 |
''' <param name="Grosseur"></param>
|
| 1578 |
''' <returns>Le Body2 représentant la flèche</returns>
|
| 1579 |
''' <remarks></remarks>
|
| 1580 |
Public Function FlecheTemporaire(ByVal CentreX As Double, ByVal centreY As Double, ByVal centreZ As Double, ByVal Dx As Double, ByVal Dy As Double, ByVal Dz As Double, Optional ByVal Rouge As Integer = 255, Optional ByVal Vert As Integer = 0, Optional ByVal Bleu As Integer = 0, Optional ByVal Longueur As Double = 1) As sldworks.Body2
|
| 1581 |
Dim P(2) As Double
|
| 1582 |
Dim Bod1, bod2 As sldworks.Body2
|
| 1583 |
Dim vBod As Object
|
| 1584 |
Dim errcode As Integer
|
| 1585 |
|
| 1586 |
Bod1 = CylindreTemporaire(CentreX, centreY, centreZ, Dx, Dy, Dz, Longueur, RGB(Rouge, Vert, Bleu))
|
| 1587 |
|
| 1588 |
P(0) = Dx : P(1) = Dy : P(2) = Dz
|
| 1589 |
P = Outils_Math.unitaire(P)
|
| 1590 |
bod2 = ConeTemporaire(CentreX + P(0) * Longueur, centreY + P(1) * Longueur, centreZ + P(2) * Longueur, Dx, Dy, Dz, Longueur, RGB(Rouge, Vert, Bleu))
|
| 1591 |
vBod = Bod1.Operations2(swconst.swBodyOperationType_e.SWBODYADD, bod2, errcode)
|
| 1592 |
Return vBod(0)
|
| 1593 |
|
| 1594 |
End Function
|
| 1595 |
|
| 1596 |
|
| 1597 |
|
| 1598 |
''' <summary>
|
| 1599 |
''' Dessine un cylindre avec un temporary body
|
| 1600 |
''' </summary>
|
| 1601 |
''' <param name="CentreX"></param>
|
| 1602 |
''' <param name="centreY"></param>
|
| 1603 |
''' <param name="centreZ"></param>
|
| 1604 |
''' <param name="Dx"></param>
|
| 1605 |
''' <param name="Dy"></param>
|
| 1606 |
''' <param name="Dz"></param>
|
| 1607 |
''' <param name="longueur"></param>
|
| 1608 |
''' <param name="couleur"></param>
|
| 1609 |
''' <remarks></remarks>
|
| 1610 |
Public Function CylindreTemporaire(ByVal CentreX As Double, ByVal centreY As Double, ByVal centreZ As Double, ByVal Dx As Double, ByVal Dy As Double, ByVal Dz As Double, ByVal longueur As Double, ByVal couleur As Integer) As sldworks.Body2
|
| 1611 |
Dim View As sldworks.ModelView = swModel.ActiveView()
|
| 1612 |
Dim swModeler As sldworks.Modeler = swApp.GetModeler
|
| 1613 |
Dim NewBod As sldworks.Body2
|
| 1614 |
Dim liste(7) As Double, vListe As Object
|
| 1615 |
|
| 1616 |
liste(0) = CentreX ' les 3 points de centre
|
| 1617 |
liste(1) = centreY
|
| 1618 |
liste(2) = centreZ
|
| 1619 |
liste(3) = Dx ' l'axe du cone
|
| 1620 |
liste(4) = Dy
|
| 1621 |
liste(5) = Dz
|
| 1622 |
liste(6) = longueur / 6 ' radius, le 1/6 de la longueur
|
| 1623 |
liste(7) = longueur ' hauteur
|
| 1624 |
|
| 1625 |
vListe = liste
|
| 1626 |
NewBod = swModeler.CreateBodyFromCyl(vListe)
|
| 1627 |
NewBod.Display2(swPart, couleur, 0)
|
| 1628 |
Return NewBod
|
| 1629 |
End Function
|
| 1630 |
|
| 1631 |
''' <summary>
|
| 1632 |
''' Dessine un cone avec un temporary body
|
| 1633 |
''' </summary>
|
| 1634 |
''' <param name="CentreX"></param>
|
| 1635 |
''' <param name="centreY"></param>
|
| 1636 |
''' <param name="centreZ"></param>
|
| 1637 |
''' <param name="Dx"></param>
|
| 1638 |
''' <param name="Dy"></param>
|
| 1639 |
''' <param name="Dz"></param>
|
| 1640 |
''' <param name="longueur"></param>
|
| 1641 |
''' <param name="couleur"></param>
|
| 1642 |
''' <remarks></remarks>
|
| 1643 |
Public Function ConeTemporaire(ByVal CentreX As Double, ByVal centreY As Double, ByVal centreZ As Double, ByVal Dx As Double, ByVal Dy As Double, ByVal Dz As Double, ByVal longueur As Double, ByVal couleur As Integer) As sldworks.Body2
|
| 1644 |
Dim View As sldworks.ModelView = swModel.ActiveView()
|
| 1645 |
Dim swModeler As sldworks.Modeler = swApp.GetModeler
|
| 1646 |
Dim liste(8) As Double, vListe As Object
|
| 1647 |
Dim NewBod As sldworks.Body2
|
| 1648 |
|
| 1649 |
liste(0) = CentreX ' les 3 points de centre
|
| 1650 |
liste(1) = centreY
|
| 1651 |
liste(2) = centreZ
|
| 1652 |
liste(3) = Dx ' l'axe du cone
|
| 1653 |
liste(4) = Dy
|
| 1654 |
liste(5) = Dz
|
| 1655 |
liste(6) = longueur / 2 ' base radius
|
| 1656 |
liste(7) = 0 'top radius
|
| 1657 |
liste(8) = longueur ' hauteur
|
| 1658 |
vListe = liste
|
| 1659 |
NewBod = swModeler.CreateBodyFromCone(vListe)
|
| 1660 |
NewBod.Display2(swPart, couleur, 0)
|
| 1661 |
Return NewBod
|
| 1662 |
End Function
|
| 1663 |
|
| 1664 |
|
| 1665 |
|
| 1666 |
''' <summary>
|
| 1667 |
''' Créer une annotation qui pointe sur les coordonnées spécifiées
|
| 1668 |
''' </summary>
|
| 1669 |
''' <param name="x">La flèche de l'annotation pointera dessu.</param>
|
| 1670 |
''' <param name="y"></param>
|
| 1671 |
''' <param name="z"></param>
|
| 1672 |
''' <param name="Texte">Le texte à y écrire</param>
|
| 1673 |
''' <remarks></remarks>
|
| 1674 |
Public Sub CreerAnnotation(ByVal x As Double, ByVal y As Double, ByVal z As Double, Optional ByVal Texte As String = " NT ")
|
| 1675 |
Commun.MettreUnPoint(x, y, z, True)
|
| 1676 |
Dim swNote As sldworks.Note
|
| 1677 |
swNote = swModel.InsertNote(Texte)
|
| 1678 |
End Sub
|
| 1679 |
|
| 1680 |
|
| 1681 |
|
| 1682 |
|
| 1683 |
|
| 1684 |
Public Class Point
|
| 1685 |
Public X As Double
|
| 1686 |
Public Y As Double
|
| 1687 |
Public Z As Double
|
| 1688 |
|
| 1689 |
''' <summary>
|
| 1690 |
''' Attention de ne pas oublier de fixer les valeurs de x,y et z plus tard.
|
| 1691 |
''' </summary>
|
| 1692 |
''' <remarks></remarks>
|
| 1693 |
Public Sub New()
|
| 1694 |
|
| 1695 |
End Sub
|
| 1696 |
|
| 1697 |
Public Sub New(ByVal x As Double, ByVal y As Double, ByVal z As Double)
|
| 1698 |
Me.X = x : Me.Y = y : Me.Z = z
|
| 1699 |
End Sub
|
| 1700 |
|
| 1701 |
Public Shared Operator =(ByVal P1 As Point, ByVal P2 As Point) As Boolean
|
| 1702 |
If Math.Abs(P1.X - P2.X) < Epsilon AndAlso Math.Abs(P1.Y - P2.Y) < Epsilon AndAlso Math.Abs(P1.Z - P2.Z) < Epsilon Then Return True Else Return False
|
| 1703 |
End Operator
|
| 1704 |
|
| 1705 |
Public Shared Operator <>(ByVal P1 As Point, ByVal P2 As Point) As Boolean
|
| 1706 |
If Math.Abs(P1.X - P2.X) < Epsilon AndAlso Math.Abs(P1.Y - P2.Y) < Epsilon AndAlso Math.Abs(P1.Z - P2.Z) < Epsilon Then Return False Else Return True
|
| 1707 |
End Operator
|
| 1708 |
|
| 1709 |
Public Shared Narrowing Operator CType(ByVal P As Point) As String
|
| 1710 |
Return (Replace(CStr(P.X), ",", ".") & " " & Replace(CStr(P.Y), ",", ".") & " " & Replace(CStr(P.Z), ",", "."))
|
| 1711 |
End Operator
|
| 1712 |
|
| 1713 |
|
| 1714 |
End Class
|
| 1715 |
|
| 1716 |
|
| 1717 |
|
| 1718 |
|
| 1719 |
End Module
|
