| 1 |
Imports SolidWorks.Interop
|
| 2 |
Imports SolidWorks.Interop.swconst
|
| 3 |
Imports SolidWorks.Interop.swpublished
|
| 4 |
|
| 5 |
Public Class SuperFace
|
| 6 |
Inherits SuperEntite
|
| 7 |
|
| 8 |
'Public swFace As SldWorks.Face2
|
| 9 |
Private Shared compteur As Long
|
| 10 |
Private Shared no As Long
|
| 11 |
|
| 12 |
Friend Flag As Integer = 0 ' = 20 si on a une coupeLong
|
| 13 |
|
| 14 |
|
| 15 |
Friend lst_Faces As New Collections.Generic.List(Of SldWorks.Face2) ' une liste de faces supplémentaires si me.swFace est coupée en 3.
|
| 16 |
Friend lst_InterPoutre As New Collection() ' liste des poutres qui intersectionnent
|
| 17 |
Friend lst_InterCoqueVolume As New Collections.Generic.List(Of InterCoqueVolume) ' liste des intersections avec d'autres faces
|
| 18 |
Friend lst_InterCoqueCoque As New Collections.Generic.List(Of InterCoqueCoque)
|
| 19 |
|
| 20 |
|
| 21 |
Friend AttributCL As SldWorks.Attribute ' une l'attribut de condition aux imites qui doit être updaté
|
| 22 |
Private swSurface As SldWorks.Surface
|
| 23 |
|
| 24 |
|
| 25 |
''' <summary>
|
| 26 |
''' Renvoie le nombre de swFaces qui composent cette superface
|
| 27 |
''' </summary>
|
| 28 |
''' <value></value>
|
| 29 |
''' <returns></returns>
|
| 30 |
''' <remarks></remarks>
|
| 31 |
Public ReadOnly Property GetNbFaces() As Long
|
| 32 |
Get
|
| 33 |
Return lst_Faces.Count
|
| 34 |
End Get
|
| 35 |
End Property
|
| 36 |
|
| 37 |
|
| 38 |
|
| 39 |
''' <summary>
|
| 40 |
''' New pour un encapsulateur temporaire de face
|
| 41 |
''' </summary>
|
| 42 |
''' <param name="Face"></param>
|
| 43 |
''' <param name="encapsulateur"></param>
|
| 44 |
''' <remarks></remarks>
|
| 45 |
Public Sub New(ByRef Face As SldWorks.Face2, ByRef encapsulateur As Boolean)
|
| 46 |
lst_Faces.Add(Face)
|
| 47 |
End Sub
|
| 48 |
|
| 49 |
Friend Sub New(ByRef face As SldWorks.Face2, Optional ByVal tip As Integer = 0)
|
| 50 |
Me.AjouterFace(face)
|
| 51 |
Select Case tip
|
| 52 |
Case Commun.tipe_e.Volume
|
| 53 |
nom = "Face" & compteur
|
| 54 |
Case Commun.tipe_e.coque
|
| 55 |
nom = "FaceCoque" & compteur
|
| 56 |
End Select
|
| 57 |
nomOrig = nom
|
| 58 |
compteur = compteur + 1
|
| 59 |
End Sub
|
| 60 |
|
| 61 |
|
| 62 |
Friend Overridable Function UpdateApresSplit(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre, ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef Plan As SldWorks.RefPlane, Optional ByRef FI As Boolean = False) As SldWorks.Face2
|
| 63 |
MsgBox("La fonction non overridée a été appelée!")
|
| 64 |
Return Nothing
|
| 65 |
End Function
|
| 66 |
|
| 67 |
Friend Overridable Function UpdateApresSplit(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre, ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef Plan As SldWorks.RefPlane, Optional ByRef FI As Boolean = False) As SldWorks.Face2
|
| 68 |
MsgBox("La fonction non overridée a été appelée!")
|
| 69 |
Return Nothing
|
| 70 |
End Function
|
| 71 |
|
| 72 |
''' <summary>
|
| 73 |
''' Sub qui ajoute des mini-poutres à la section entre le sommet de la poutre et un point de la face interne
|
| 74 |
''' </summary>
|
| 75 |
''' <param name="poutre">La poutre principale</param>
|
| 76 |
''' <param name="FaceInterne">La face où il faut ajouter UNE mini-poutre</param>
|
| 77 |
''' <param name="x1">Coordonnée en x du point d'intersection</param>
|
| 78 |
''' <param name="y1"></param>
|
| 79 |
''' <param name="z1"></param>
|
| 80 |
''' <remarks>On pourrait ajouter plus d'une mini-poutre.</remarks>
|
| 81 |
Friend Sub AjouterMiniPoutresSurFaceInterne(ByRef poutre As SlyAretePoutre, ByRef FaceInterne As SldWorks.Face2, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double)
|
| 82 |
Dim x2 As Double, y2 As Double, z2 As Double
|
| 83 |
Dim swSketch As SldWorks.Sketch
|
| 84 |
Static k As Integer
|
| 85 |
Dim swEnt As SldWorks.Entity
|
| 86 |
Dim p As SldWorks.Parameter
|
| 87 |
Dim refCourbe As SldWorks.ReferenceCurve
|
| 88 |
Dim feat As SldWorks.Feature
|
| 89 |
Dim attr As SldWorks.Attribute
|
| 90 |
|
| 91 |
' 2 trouver un sommet ou un point sur la face interne.
|
| 92 |
Dim swArete As SldWorks.Edge
|
| 93 |
Dim swSommet2 As SldWorks.Vertex
|
| 94 |
|
| 95 |
swArete = FaceInterne.GetFirstLoop.GetFirstCoEdge.getedge
|
| 96 |
swSommet2 = swArete.GetStartVertex()
|
| 97 |
|
| 98 |
If swSommet2 Is Nothing Then ' un celcle (ou ellipse)
|
| 99 |
Dim retval As Object
|
| 100 |
retval = swArete.Evaluate(0) ' il va y avor un LC point anyway...
|
| 101 |
x2 = retval(0)
|
| 102 |
y2 = retval(1)
|
| 103 |
z2 = retval(2)
|
| 104 |
|
| 105 |
Else
|
| 106 |
Dim retval As Object
|
| 107 |
retval = swSommet2.GetPoint()
|
| 108 |
x2 = retval(0)
|
| 109 |
y2 = retval(1)
|
| 110 |
z2 = retval(2)
|
| 111 |
End If
|
| 112 |
|
| 113 |
|
| 114 |
' 3 faire une mini-poutre entre les 2
|
| 115 |
|
| 116 |
swModel.Insert3DSketch2(True)
|
| 117 |
swModel.CreateLine2(x1, y1, z1, x2, y2, z2)
|
| 118 |
swSketch = swModel.GetActiveSketch2()
|
| 119 |
swModel.Insert3DSketch2(True)
|
| 120 |
swEnt = swSketch : swEnt.Select2(False, 1)
|
| 121 |
swModel.InsertCompositeCurve()
|
| 122 |
|
| 123 |
' reste à lui mettre les propriétés de mini-poutres
|
| 124 |
feat = swModel.FeatureByPositionReverse(0)
|
| 125 |
refCourbe = feat.GetSpecificFeature2
|
| 126 |
swArete = refCourbe.GetFirstSegment ' y'a juste un segment
|
| 127 |
|
| 128 |
swEnt = swArete
|
| 129 |
Dim NomAttr As String
|
| 130 |
NomAttr = "miniPoutre" & Me.nom & k
|
| 131 |
|
| 132 |
attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, swArete, NomAttr, 0, 0)
|
| 133 |
' mettre les propriétés de la mini-poutre
|
| 134 |
' attention, elle ne doit pas avoir de masse, sa section est alors Mini...
|
| 135 |
|
| 136 |
p = attr.GetParameter("As")
|
| 137 |
p.SetDoubleValue2(-7, 2, "")
|
| 138 |
Commun.GererDossiers("Poutres", NomAttr)
|
| 139 |
k += 1
|
| 140 |
|
| 141 |
|
| 142 |
End Sub
|
| 143 |
|
| 144 |
|
| 145 |
Friend Overridable Function AjouterInterFace(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterCoqueVolume
|
| 146 |
' sub qui CRÉÉ une instance de la classe InterFaceFace si et seulement si il n'en existe pas avant
|
| 147 |
|
| 148 |
|
| 149 |
'Dim int As InterFaceFace
|
| 150 |
|
| 151 |
' créez la routine qui ignore la création de
|
| 152 |
Return Nothing ' pout l'instant
|
| 153 |
End Function
|
| 154 |
|
| 155 |
|
| 156 |
|
| 157 |
Shared Sub reinitialiser()
|
| 158 |
compteur = 0
|
| 159 |
End Sub
|
| 160 |
|
| 161 |
Public Overrides Sub SaveNom()
|
| 162 |
' procédure qui enregistre le nom et qui , pour l'instant ne tient pas compte des conditions aux limites
|
| 163 |
Dim ent As SldWorks.Entity
|
| 164 |
Dim i As Long
|
| 165 |
Dim nomtemp As String
|
| 166 |
'For i = 1 To Me.lst_Faces.Count
|
| 167 |
For Each swFace As SldWorks.Face2 In Me.lst_Faces
|
| 168 |
ent = swFace
|
| 169 |
Dim retval As Boolean
|
| 170 |
If Me.lst_Faces.Count > 1 Then nomtemp = nom & "-" & Chr(i + 96) Else nomtemp = nom
|
| 171 |
retval = swPart.SetEntityName(ent, nomtemp)
|
| 172 |
If retval = False Then
|
| 173 |
Dim nom2 As String
|
| 174 |
'Dim swface As SldWorks.Face2
|
| 175 |
'swface = ent
|
| 176 |
'If Me.SwFace Is swface Then MsgBox("La même face!")
|
| 177 |
nom2 = swPart.GetEntityName(ent)
|
| 178 |
'MsgBox("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom ( " & nom2 & " ) " & Chr(13) & "Et on veut écrire à la place --> " & nomtemp, MsgBoxStyle.Critical, "Problème dans le setID de SlyFaceVol")
|
| 179 |
Debug.Print("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom ( " & nom2 & " ) " & Chr(13) & "Et on veut écrire à la place --> " & nomtemp, MsgBoxStyle.Critical, "Problème dans le setID de SlyFaceVol")
|
| 180 |
End If
|
| 181 |
Next
|
| 182 |
|
| 183 |
|
| 184 |
|
| 185 |
End Sub
|
| 186 |
|
| 187 |
|
| 188 |
Public Function GetNormale(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double()
|
| 189 |
Dim surf As SldWorks.Surface
|
| 190 |
Dim retval As Object
|
| 191 |
Dim temp(2) As Double
|
| 192 |
|
| 193 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 194 |
retval = surf.EvaluateAtPoint(x, y, z)
|
| 195 |
|
| 196 |
If retval Is Nothing Then MsgBox("Erreur, dans le Getnormal de la face, le point ne semble pas être sur la face")
|
| 197 |
|
| 198 |
temp(0) = retval(0)
|
| 199 |
temp(1) = retval(1)
|
| 200 |
temp(2) = retval(2)
|
| 201 |
|
| 202 |
Return temp
|
| 203 |
End Function
|
| 204 |
Public Function GetNormaleSurface(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double()
|
| 205 |
Dim surf As SldWorks.Surface
|
| 206 |
Dim retval As Object = Nothing
|
| 207 |
Dim temp(2) As Double
|
| 208 |
|
| 209 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 210 |
retval = surf.EvaluateAtPoint(x, y, z)
|
| 211 |
|
| 212 |
temp(0) = retval(0)
|
| 213 |
temp(1) = retval(1)
|
| 214 |
temp(2) = retval(2)
|
| 215 |
|
| 216 |
Return temp
|
| 217 |
End Function
|
| 218 |
|
| 219 |
|
| 220 |
|
| 221 |
Public Function GetRayonCourbureMax(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
|
| 222 |
Dim surf As SldWorks.Surface
|
| 223 |
Dim retval As Object
|
| 224 |
Dim temp As Double
|
| 225 |
|
| 226 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 227 |
retval = surf.EvaluateAtPoint(x, y, z)
|
| 228 |
|
| 229 |
temp = retval(9)
|
| 230 |
|
| 231 |
Return temp
|
| 232 |
End Function
|
| 233 |
|
| 234 |
Public Function GetRayonCourbureMin(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
|
| 235 |
Dim surf As SldWorks.Surface
|
| 236 |
Dim retval As Object
|
| 237 |
Dim temp As Double
|
| 238 |
|
| 239 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 240 |
retval = surf.EvaluateAtPoint(x, y, z)
|
| 241 |
|
| 242 |
temp = retval(10)
|
| 243 |
|
| 244 |
Return temp
|
| 245 |
End Function
|
| 246 |
|
| 247 |
' si la surface est un cylindre, retourne son rayon. Plante ou valeur aléatoire si pas un cylindre
|
| 248 |
Public Function GetRayonCylindre() As Double
|
| 249 |
Dim surf As SldWorks.Surface
|
| 250 |
Dim retval As Object
|
| 251 |
Dim temp As Double
|
| 252 |
|
| 253 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 254 |
retval = surf.CylinderParams
|
| 255 |
|
| 256 |
temp = retval(6)
|
| 257 |
|
| 258 |
Return temp
|
| 259 |
End Function
|
| 260 |
|
| 261 |
|
| 262 |
''' <summary>
|
| 263 |
''' Retourne vrai si une face est plane
|
| 264 |
''' </summary>
|
| 265 |
''' <returns></returns>
|
| 266 |
''' <remarks></remarks>
|
| 267 |
Public Function estPlan() As Boolean
|
| 268 |
Dim surf As SldWorks.Surface
|
| 269 |
|
| 270 |
surf = Me.lst_Faces.Item(0).GetSurface()
|
| 271 |
|
| 272 |
If surf.IsPlane Then Return True Else Return False
|
| 273 |
|
| 274 |
End Function
|
| 275 |
|
| 276 |
|
| 277 |
''' <summary>
|
| 278 |
''' Retourne vrai si la face est un plan mais pas vu comme tel par solidworks.
|
| 279 |
''' </summary>
|
| 280 |
''' <param name="x"></param>
|
| 281 |
''' <param name="y"></param>
|
| 282 |
''' <param name="z"></param>
|
| 283 |
''' <returns></returns>
|
| 284 |
''' <remarks></remarks>
|
| 285 |
Public Function estFauxPlan(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean
|
| 286 |
Dim surf As SldWorks.Surface
|
| 287 |
surf = Me.lst_Faces.Item(0).GetSurface()
|
| 288 |
If Not surf.IsParametric Then Return False
|
| 289 |
|
| 290 |
' si la normale est la même au point d'intersection et à quelques sommets, alors on a une face plane.
|
| 291 |
Dim Normale(2) As Double
|
| 292 |
Dim vNormale As Object
|
| 293 |
|
| 294 |
vNormale = surf.EvaluateAtPoint(x, y, z) ' la normale du point d'intersection
|
| 295 |
Normale(0) = vNormale(0)
|
| 296 |
Normale(1) = vNormale(1)
|
| 297 |
Normale(2) = vNormale(2)
|
| 298 |
|
| 299 |
Dim i As Integer
|
| 300 |
Dim U As Double, V As Double, Umin As Double, Umax As Double, Vmin As Double, Vmax As Double
|
| 301 |
Dim retval As Object
|
| 302 |
|
| 303 |
retval = surf.Parameterization()
|
| 304 |
Umin = retval(0)
|
| 305 |
Umax = retval(1)
|
| 306 |
Vmin = retval(2)
|
| 307 |
Vmax = retval(3)
|
| 308 |
|
| 309 |
Randomize()
|
| 310 |
|
| 311 |
For i = 0 To 5
|
| 312 |
U = Rnd() * (Umax - Umin) + Umin
|
| 313 |
V = Rnd() * (Vmax - Vmin) + Vmin
|
| 314 |
vNormale = surf.Evaluate(U, V, 0, 0)
|
| 315 |
If Not (Math.Abs(vNormale(3) - Normale(0)) < Epsilon And Math.Abs(vNormale(4) - Normale(1)) < Epsilon And Math.Abs(vNormale(5) - Normale(2)) < Epsilon) Then Return False
|
| 316 |
Next i
|
| 317 |
|
| 318 |
Return True
|
| 319 |
|
| 320 |
|
| 321 |
|
| 322 |
End Function
|
| 323 |
|
| 324 |
Public Function estCylindre() As Boolean
|
| 325 |
Dim surf As SldWorks.Surface
|
| 326 |
|
| 327 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 328 |
|
| 329 |
If surf.IsCylinder Then Return True Else Return False
|
| 330 |
|
| 331 |
End Function
|
| 332 |
|
| 333 |
|
| 334 |
Protected Overrides Sub Finalize()
|
| 335 |
' mettre l'effacement des listes ici.
|
| 336 |
|
| 337 |
MyBase.Finalize()
|
| 338 |
End Sub
|
| 339 |
|
| 340 |
|
| 341 |
|
| 342 |
Public Sub MettreAttributPourConditionLimite()
|
| 343 |
Dim swent As SldWorks.Entity
|
| 344 |
Dim nom As String
|
| 345 |
Dim cond As String
|
| 346 |
|
| 347 |
cond = Me.condition
|
| 348 |
If cond = "" Then Exit Sub
|
| 349 |
|
| 350 |
swent = Me.SwFace
|
| 351 |
|
| 352 |
nom = Me.nom & "CL" & CStr(no) & "_" & cond
|
| 353 |
Dim Attr As SldWorks.Attribute = Nothing
|
| 354 |
|
| 355 |
Try
|
| 356 |
Attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
|
| 357 |
Catch ex As Exception
|
| 358 |
MsgBox("N'arrive pas à se lier à l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
|
| 359 |
End Try
|
| 360 |
|
| 361 |
If Attr Is Nothing Then Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.SwFace, nom, 0, 2) ' 0 = swThisconfig
|
| 362 |
|
| 363 |
|
| 364 |
While Attr Is Nothing
|
| 365 |
no += 1
|
| 366 |
nom = "CL" & Me.nom & "_" & cond
|
| 367 |
Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.SwFace, nom, 0, 0)
|
| 368 |
End While
|
| 369 |
|
| 370 |
|
| 371 |
Dim ParamCL As SldWorks.Parameter
|
| 372 |
ParamCL = Attr.GetParameter("CL")
|
| 373 |
|
| 374 |
ParamCL.SetStringValue2(cond, 2, "") ' swAllConfiguration = 2
|
| 375 |
Me.AttributCL = Attr
|
| 376 |
GererDossiers("Conditions Aux Limites", nom)
|
| 377 |
no = no + 1
|
| 378 |
|
| 379 |
End Sub
|
| 380 |
|
| 381 |
' une fonction qui transforme un attribut en condition aux limites
|
| 382 |
Public Sub AttributVersConditionLimite()
|
| 383 |
Dim p As SldWorks.Parameter
|
| 384 |
Dim ent As SldWorks.Entity
|
| 385 |
Dim attr As SldWorks.Attribute
|
| 386 |
|
| 387 |
ent = Me.SwFace
|
| 388 |
attr = ent.FindAttribute(Intersections.DefAttrConditionLimite, 0)
|
| 389 |
If Not attr Is Nothing Then
|
| 390 |
p = attr.GetParameter("CL")
|
| 391 |
nom = nomOrig & "@" & p.GetStringValue
|
| 392 |
End If
|
| 393 |
|
| 394 |
End Sub
|
| 395 |
|
| 396 |
|
| 397 |
' sub qui découpe les bords de la face.
|
| 398 |
Friend Sub CoupeCote(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre)
|
| 399 |
Dim pt3() As Double, pt3Original() As Double
|
| 400 |
Dim base(2) As Double, baseOriginal(2) As Double
|
| 401 |
Dim swEnt As SldWorks.Entity
|
| 402 |
Dim Directionnel As Boolean, Flip As Boolean
|
| 403 |
Dim planReference As SldWorks.RefPlane = Nothing
|
| 404 |
Dim sketchline As SldWorks.SketchSegment
|
| 405 |
Dim swSketch As SldWorks.Sketch
|
| 406 |
Dim DemiLargeur As Double
|
| 407 |
Dim g As Integer
|
| 408 |
Dim Face(1) As SldWorks.Face2
|
| 409 |
Dim PlanEntity As SldWorks.Entity = Nothing
|
| 410 |
Dim r(2) As Double
|
| 411 |
Dim sk(1) As Double
|
| 412 |
pt3Original = poutre.GetPoint3
|
| 413 |
|
| 414 |
|
| 415 |
swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
|
| 416 |
'swModel.SetAddToDB(True)
|
| 417 |
'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
|
| 418 |
|
| 419 |
Dim vArete As Object
|
| 420 |
Dim cut As Double
|
| 421 |
|
| 422 |
If Me.estPlan Then
|
| 423 |
' la coque est plane, on met une esquisse dessus.#
|
| 424 |
PlanEntity = Me.SwFace
|
| 425 |
|
| 426 |
ElseIf Me.estCylindre Then
|
| 427 |
' on doit créer un plan de référence...
|
| 428 |
|
| 429 |
ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
|
| 430 |
Dim vEdge As Object
|
| 431 |
Dim i As Integer
|
| 432 |
Dim swArete2() As SldWorks.Edge
|
| 433 |
Dim swSommet As SldWorks.Vertex
|
| 434 |
|
| 435 |
vEdge = Me.SwFace.GetEdges
|
| 436 |
swArete2 = vEdge
|
| 437 |
swModel.ClearSelection2(True)
|
| 438 |
|
| 439 |
While planReference Is Nothing
|
| 440 |
If UBound(swArete2) - 2 < i Then MsgBox("Dans CoupeLong, problème pour créer un plan avec 3 points. (La face est un FauxPlan)", MsgBoxStyle.Critical, "Le plan ne sera pas créé") : Exit While
|
| 441 |
swSommet = swArete2(i).GetStartVertex()
|
| 442 |
swEnt = swSommet
|
| 443 |
swEnt.Select4(False, Nothing)
|
| 444 |
swArete2(i + 1).GetStartVertex()
|
| 445 |
swEnt = swSommet
|
| 446 |
swEnt.Select4(True, Nothing)
|
| 447 |
swArete2(i + 2).GetStartVertex()
|
| 448 |
swEnt = swSommet
|
| 449 |
swEnt.Select4(True, Nothing)
|
| 450 |
i += 1
|
| 451 |
planReference = swModel.CreatePlaneThru3Points3(False)
|
| 452 |
PlanEntity = planReference
|
| 453 |
End While
|
| 454 |
|
| 455 |
|
| 456 |
Else ' la face est une spline
|
| 457 |
MsgBox("Dans coupeCoté, la face est un type de surface qui n'est pas encore traité")
|
| 458 |
End If
|
| 459 |
|
| 460 |
|
| 461 |
baseOriginal(0) = inter.x : baseOriginal(1) = inter.y : baseOriginal(2) = inter.z
|
| 462 |
|
| 463 |
|
| 464 |
Dim Psi As Double
|
| 465 |
Dim u(2) As Double, v(2) As Double, usketch(2) As Double, vsketch(2) As Double
|
| 466 |
Dim Arete As SldWorks.Edge = Nothing
|
| 467 |
Dim retval As Object
|
| 468 |
u = poutre.GetOrientation(inter.x, inter.y, inter.z)
|
| 469 |
|
| 470 |
|
| 471 |
vArete = Me.SwFace.GetEdges
|
| 472 |
|
| 473 |
For Each Arete In vArete
|
| 474 |
If Commun.Distance(Arete, inter.x, inter.y, inter.z) < Epsilon Then Exit For
|
| 475 |
Next
|
| 476 |
|
| 477 |
retval = Arete.GetClosestPointOn(inter.x, inter.y, inter.z)
|
| 478 |
retval = Arete.Evaluate(retval(3))
|
| 479 |
v(0) = retval(3) : v(1) = retval(4) : v(2) = retval(5)
|
| 480 |
|
| 481 |
|
| 482 |
|
| 483 |
|
| 484 |
For g = 0 To 1
|
| 485 |
|
| 486 |
PlanEntity.Select(False)
|
| 487 |
swModel.InsertSketch2(True)
|
| 488 |
swSketch = swModel.GetActiveSketch2
|
| 489 |
|
| 490 |
pt3 = Commun.TransfertModelSketch(swSketch, pt3Original)
|
| 491 |
usketch = Commun.TransfertModelSketch(swSketch, u) ' on les met dans le plan du sketch
|
| 492 |
vsketch = Commun.TransfertModelSketch(swSketch, v)
|
| 493 |
base = Commun.TransfertModelSketch(swSketch, baseOriginal)
|
| 494 |
Psi = Outils_Math.cosdir(usketch, vsketch)
|
| 495 |
|
| 496 |
Dim a As Double, b As Double
|
| 497 |
'longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
|
| 498 |
'If pt3(1) = 0 Then a = 999999999999 Else a = Math.Abs(poutre.GetD2() * longueur / pt3(1))
|
| 499 |
'If pt3(0) = 0 Then b = 999999999999 Else b = Math.Abs(poutre.GetD1() * longueur / pt3(0))
|
| 500 |
' À revoir. Si le plan est un cylindre ça marche plus. sans compter l'épaisseur de la poutre.
|
| 501 |
' pour l'instant je prend la plus prtite valeur...
|
| 502 |
a = poutre.GetD1
|
| 503 |
b = poutre.GetD2
|
| 504 |
DemiLargeur = Math.Min(a, b)
|
| 505 |
cut = DemiLargeur / Math.Sin(Pi / 2 - Psi)
|
| 506 |
|
| 507 |
|
| 508 |
Dim P1(1) As Double
|
| 509 |
Dim P2(1) As Double
|
| 510 |
Dim P3(1) As Double
|
| 511 |
Dim P4(1) As Double
|
| 512 |
Dim Ptest(2) As Double
|
| 513 |
|
| 514 |
|
| 515 |
If g = 0 Then
|
| 516 |
P1(0) = -cut
|
| 517 |
P1(1) = -cut '* mult ' 0
|
| 518 |
P2(0) = 0
|
| 519 |
P2(1) = -cut '* mult ' 0
|
| 520 |
P3(0) = 0
|
| 521 |
P3(1) = cut 'Intersections.Taille mult
|
| 522 |
P4(0) = -cut
|
| 523 |
P4(1) = cut 'Intersections.Taille mult
|
| 524 |
sk(0) = -Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
|
| 525 |
|
| 526 |
Else
|
| 527 |
P1(0) = 0
|
| 528 |
P1(1) = -cut '* mult '0
|
| 529 |
P2(0) = +cut
|
| 530 |
P2(1) = -cut '* mult '0
|
| 531 |
P3(0) = +cut
|
| 532 |
P3(1) = cut 'Intersections.Taille mult
|
| 533 |
P4(0) = 0
|
| 534 |
P4(1) = cut 'Intersections.Taille mult
|
| 535 |
sk(0) = Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
|
| 536 |
|
| 537 |
End If
|
| 538 |
|
| 539 |
P1 = Outils_Math.Rotation2D(vsketch, P1)
|
| 540 |
P2 = Outils_Math.Rotation2D(vsketch, P2)
|
| 541 |
P3 = Outils_Math.Rotation2D(vsketch, P3)
|
| 542 |
P4 = Outils_Math.Rotation2D(vsketch, P4)
|
| 543 |
sk = Outils_Math.Rotation2D(vsketch, sk)
|
| 544 |
|
| 545 |
sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P2(0) + base(0), P2(1) + base(1), 0)
|
| 546 |
sketchline = swModel.CreateLine2(P2(0) + base(0), P2(1) + base(1), 0, P3(0) + base(0), P3(1) + base(1), 0)
|
| 547 |
sketchline = swModel.CreateLine2(P3(0) + base(0), P3(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
|
| 548 |
sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
|
| 549 |
|
| 550 |
swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
|
| 551 |
swModel.ClearSelection2(True)
|
| 552 |
swEnt = Me.SwFace : swEnt.Select2(False, 1)
|
| 553 |
swEnt = swSketch : swEnt.Select2(True, 4)
|
| 554 |
|
| 555 |
swModel.InsertSplitLineProject(Directionnel, Flip)
|
| 556 |
r = Commun.TransfertSketchToModel(swSketch, sk)
|
| 557 |
Face(g) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference)
|
| 558 |
'If Face(g) Is Nothing Then
|
| 559 |
'swSketch.Select(False)
|
| 560 |
'swModel.EditDelete()
|
| 561 |
'End If
|
| 562 |
|
| 563 |
Next g
|
| 564 |
|
| 565 |
|
| 566 |
|
| 567 |
' mettre les mini-poutres
|
| 568 |
Dim vEdge2 As Object
|
| 569 |
Dim swArete As SldWorks.Edge
|
| 570 |
Dim vPoint As Object
|
| 571 |
Dim Mini1 As SldWorks.Edge = Nothing, Mini2 As SldWorks.Edge = Nothing
|
| 572 |
|
| 573 |
|
| 574 |
' 1 - trouver les 2 arrères dont l'orientation est la même (ou l'inverse) que le v
|
| 575 |
For g = 0 To 1
|
| 576 |
If Not Face(g) Is Nothing Then
|
| 577 |
vEdge2 = Face(g).GetEdges()
|
| 578 |
|
| 579 |
|
| 580 |
' construire u
|
| 581 |
For Each swArete In vEdge2
|
| 582 |
If Commun.Distance(swArete, inter.x, inter.y, inter.z) < Epsilon Then
|
| 583 |
' l'arête touche à l'intersection,
|
| 584 |
vPoint = swArete.GetClosestPointOn(inter.x, inter.y, inter.z)
|
| 585 |
vPoint = swArete.Evaluate(vPoint(3))
|
| 586 |
u(0) = vPoint(3) : u(1) = vPoint(4) : u(2) = vPoint(5)
|
| 587 |
|
| 588 |
If Outils_Math.CompareSens(v, u) Then
|
| 589 |
' l'arète doit être une mini-poutre
|
| 590 |
If Mini1 Is Nothing Then Mini1 = swArete : Exit For Else Mini2 = swArete : Exit For
|
| 591 |
End If
|
| 592 |
End If
|
| 593 |
|
| 594 |
Next
|
| 595 |
|
| 596 |
End If
|
| 597 |
Next
|
| 598 |
|
| 599 |
swEnt = Mini1
|
| 600 |
If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
|
| 601 |
|
| 602 |
If Not Mini2 Is Nothing Then
|
| 603 |
swEnt = Mini2
|
| 604 |
If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
|
| 605 |
End If
|
| 606 |
|
| 607 |
swModel.SetInferenceMode(True) '
|
| 608 |
'swModel.SetAddToDB(False)
|
| 609 |
'swModel.SetDisplayWhenAdded(True) '
|
| 610 |
End Sub
|
| 611 |
|
| 612 |
|
| 613 |
' sub qui coupe la face avec une arète qui repose dessus.
|
| 614 |
Friend Sub CoupeLong(ByRef inter As InterPoutreVolume, ByVal poutre As SlyAretePoutre)
|
| 615 |
Dim swEnt As SldWorks.Entity
|
| 616 |
Dim swSketchSegment As SldWorks.SketchSegment
|
| 617 |
Dim vSketchSegments As Object
|
| 618 |
Dim swSketch As SldWorks.Sketch
|
| 619 |
Dim faceinterne(1) As SldWorks.Face2
|
| 620 |
Dim swPlan As SldWorks.RefPlane = Nothing
|
| 621 |
Dim b As Integer
|
| 622 |
Dim swSommet As SldWorks.Vertex
|
| 623 |
Dim i As Integer
|
| 624 |
|
| 625 |
swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
|
| 626 |
|
| 627 |
' faut découper toutes les faces de la liste si elles ne sont pas des faces internes
|
| 628 |
Dim MeFace As SldWorks.Face2
|
| 629 |
Dim ListeFace() As SldWorks.Face2
|
| 630 |
ReDim ListeFace(Me.lst_Faces.Count - 1)
|
| 631 |
|
| 632 |
For i = 1 To Me.lst_Faces.Count
|
| 633 |
ListeFace(i - 1) = Me.lst_Faces.Item(i)
|
| 634 |
Next
|
| 635 |
|
| 636 |
For Each MeFace In ListeFace
|
| 637 |
|
| 638 |
If Me.estPlan Then
|
| 639 |
swEnt = MeFace
|
| 640 |
swEnt.Select(False)
|
| 641 |
swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
|
| 642 |
swEnt.Select(False)
|
| 643 |
swModel.InsertSketch2(True)
|
| 644 |
|
| 645 |
swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
|
| 646 |
|
| 647 |
ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
|
| 648 |
If b = 0 Then
|
| 649 |
Dim vEdge As Object
|
| 650 |
|
| 651 |
|
| 652 |
vEdge = MeFace.GetEdges
|
| 653 |
swModel.ClearSelection2(True)
|
| 654 |
While swPlan Is Nothing
|
| 655 |
If UBound(vEdge) - 2 < i Then MsgBox("Dans CoupeLong, problème pour créer un plan avec 3 points. (La face est un FauxPlan)", MsgBoxStyle.Critical, "Le plan ne sera pas créé") : Exit While
|
| 656 |
swSommet = vEdge(i).GetStartVertex()
|
| 657 |
swEnt = swSommet
|
| 658 |
swEnt.Select4(False, Nothing)
|
| 659 |
swSommet = vEdge(i + 1).GetStartVertex()
|
| 660 |
swEnt = swSommet
|
| 661 |
swEnt.Select4(True, Nothing)
|
| 662 |
swSommet = vEdge(i + 2).GetStartVertex()
|
| 663 |
swEnt = swSommet
|
| 664 |
swEnt.Select4(True, Nothing)
|
| 665 |
i += 1
|
| 666 |
swPlan = swModel.CreatePlaneThru3Points3(False)
|
| 667 |
|
| 668 |
End While
|
| 669 |
End If
|
| 670 |
swEnt = swPlan
|
| 671 |
swEnt.Select(False)
|
| 672 |
swModel.InsertSketch2(True)
|
| 673 |
|
| 674 |
Else
|
| 675 |
MsgBox("Dans coupeLong, on a un type de face qui n'est pas encore traité")
|
| 676 |
|
| 677 |
End If
|
| 678 |
|
| 679 |
|
| 680 |
swSketch = swModel.GetActiveSketch2
|
| 681 |
|
| 682 |
swEnt = poutre.swArete
|
| 683 |
swEnt.Select(False)
|
| 684 |
|
| 685 |
' créer la ligne de «conversion de entités»
|
| 686 |
swModel.SketchUseEdge2(False)
|
| 687 |
|
| 688 |
vSketchSegments = swSketch.GetSketchSegments()
|
| 689 |
swSketchSegment = vSketchSegments(0)
|
| 690 |
swSketchSegment.Select2(False, 1) 'on sélectionne l'arète de poutre...
|
| 691 |
|
| 692 |
Dim x As Double, y As Double, z As Double
|
| 693 |
Commun.GetMidPointSegment(swSketchSegment, x, y, z)
|
| 694 |
|
| 695 |
|
| 696 |
' sketchoffset doit avoir un mark de 1 pour l'objet à offsetter. Une valeur négative inverse la direction
|
| 697 |
swModel.SketchManager.SketchOffset(poutre.GetD2, False, 0, 0, 0, 0)
|
| 698 |
' pour rendre le modèle plus beau, on peut enlever la contrainte de offset et laisser solidworks mettre des contraintes automatiques...
|
| 699 |
|
| 700 |
Dim retval As Object
|
| 701 |
Dim skPointA1 As SldWorks.SketchPoint = Nothing, skPointA2 As SldWorks.SketchPoint = Nothing, skPointB1 As SldWorks.SketchPoint = Nothing, skPointB2 As SldWorks.SketchPoint = Nothing
|
| 702 |
|
| 703 |
vSketchSegments = swSketch.GetSketchSegments()
|
| 704 |
swSketchSegment = vSketchSegments(1)
|
| 705 |
|
| 706 |
|
| 707 |
Select Case swSketchSegment.GetType()
|
| 708 |
Case 0 ' on a une ligne
|
| 709 |
Dim sketchline As SldWorks.SketchLine
|
| 710 |
sketchline = swSketchSegment
|
| 711 |
skPointA1 = sketchline.GetStartPoint2
|
| 712 |
skPointA2 = sketchline.GetEndPoint2()
|
| 713 |
Case 1 ' arc
|
| 714 |
Dim arc As SldWorks.SketchArc
|
| 715 |
arc = swSketchSegment
|
| 716 |
skPointA1 = arc.GetStartPoint
|
| 717 |
skPointA2 = arc.GetEndPoint2
|
| 718 |
Case 2 ' ellipse
|
| 719 |
Dim sketchEllipse As SldWorks.SketchEllipse
|
| 720 |
sketchEllipse = swSketchSegment
|
| 721 |
skPointA1 = sketchEllipse.GetStartPoint2
|
| 722 |
skPointA2 = sketchEllipse.GetEndPoint2
|
| 723 |
Case 3 ' spline
|
| 724 |
Dim spline As SldWorks.SketchSpline
|
| 725 |
Dim pts() As SldWorks.SketchPoint
|
| 726 |
spline = swSketchSegment
|
| 727 |
retval = spline.GetPoints2()
|
| 728 |
pts = retval
|
| 729 |
skPointA1 = pts(0)
|
| 730 |
skPointA2 = pts(UBound(pts))
|
| 731 |
Case 5 ' parabole (le 4 est du texte)
|
| 732 |
Dim para As SldWorks.SketchParabola
|
| 733 |
para = swSketchSegment
|
| 734 |
skPointA1 = para.GetStartPoint2
|
| 735 |
skPointA2 = para.GetEndPoint2
|
| 736 |
End Select
|
| 737 |
|
| 738 |
swSketchSegment = vSketchSegments(0)
|
| 739 |
Select Case swSketchSegment.GetType()
|
| 740 |
Case 0 ' on a une ligne
|
| 741 |
Dim sketchline As SldWorks.SketchLine
|
| 742 |
sketchline = swSketchSegment
|
| 743 |
skPointB1 = sketchline.GetStartPoint2
|
| 744 |
skPointB2 = sketchline.GetEndPoint2()
|
| 745 |
Case 1 ' arc
|
| 746 |
Dim arc As SldWorks.SketchArc
|
| 747 |
arc = swSketchSegment
|
| 748 |
skPointB1 = arc.GetStartPoint
|
| 749 |
skPointB2 = arc.GetEndPoint2
|
| 750 |
Case 2 ' ellipse
|
| 751 |
Dim sketchEllipse As SldWorks.SketchEllipse
|
| 752 |
sketchEllipse = swSketchSegment
|
| 753 |
skPointB1 = sketchEllipse.GetStartPoint2
|
| 754 |
skPointB2 = sketchEllipse.GetEndPoint2
|
| 755 |
Case 3 ' spline
|
| 756 |
Dim spline As SldWorks.SketchSpline
|
| 757 |
Dim pts() As SldWorks.SketchPoint
|
| 758 |
spline = swSketchSegment
|
| 759 |
retval = spline.GetPoints2()
|
| 760 |
pts = retval
|
| 761 |
skPointB1 = pts(0)
|
| 762 |
skPointB2 = pts(UBound(pts))
|
| 763 |
Case 5 ' parabole (le 4 est du texte)
|
| 764 |
Dim para As SldWorks.SketchParabola
|
| 765 |
para = swSketchSegment
|
| 766 |
skPointB1 = para.GetStartPoint2
|
| 767 |
skPointB2 = para.GetEndPoint2
|
| 768 |
End Select
|
| 769 |
|
| 770 |
' création des 2 lignes pour fermer le sketch.
|
| 771 |
swModel.CreateLine2(skPointA1.X, skPointA1.Y, 0, skPointB1.X, skPointB1.Y, 0)
|
| 772 |
swModel.CreateLine2(skPointA2.X, skPointA2.Y, 0, skPointB2.X, skPointB2.Y, 0)
|
| 773 |
|
| 774 |
|
| 775 |
Dim x2 As Double, y2 As Double, z2 As Double ' le midpoint de la poutre
|
| 776 |
Dim x3 As Double, y3 As Double, z3 As Double ' le midpoint de la poutre
|
| 777 |
|
| 778 |
swSketchSegment = vSketchSegments(0) ' le midpoint d'une poutre
|
| 779 |
Commun.GetMidPointSegment(swSketchSegment, x2, y2, z2)
|
| 780 |
|
| 781 |
swSketchSegment = vSketchSegments(1) ' le midpoint de l'autre poutre
|
| 782 |
Commun.GetMidPointSegment(swSketchSegment, x3, y3, z3)
|
| 783 |
|
| 784 |
Dim sk(1) As Double, r(2) As Double
|
| 785 |
sk(0) = (x3 + x2) / 2
|
| 786 |
sk(1) = (y3 + y2) / 2
|
| 787 |
r = Commun.TransfertSketchToModel(swSketch, sk)
|
| 788 |
|
| 789 |
swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
|
| 790 |
swModel.ClearSelection2(True)
|
| 791 |
swEnt = MeFace : swEnt.Select2(False, 1)
|
| 792 |
swEnt = swSketch : swEnt.Select2(True, 4)
|
| 793 |
|
| 794 |
swModel.InsertSplitLineProject(False, False)
|
| 795 |
|
| 796 |
Me.Flag = 20 ' pour dire que l'on a un coupeLong
|
| 797 |
faceinterne(b) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), swPlan) ' et ça s'occupe de créer la coque... mais je suis pas certain que c'est nécessaire
|
| 798 |
Me.Flag = 0
|
| 799 |
|
| 800 |
'If faceinterne(b) Is Nothing Then
|
| 801 |
'swEnt = swSketch
|
| 802 |
'swEnt.Select(False)
|
| 803 |
'swModel.EditDelete()
|
| 804 |
'End If
|
| 805 |
|
| 806 |
|
| 807 |
|
| 808 |
' reste à updater, on doit ajouter de 2 à 4 mini-poutres
|
| 809 |
'Dim vEdges As Object
|
| 810 |
'Dim Arete As SldWorks.Edge
|
| 811 |
'Dim vFaces As Object
|
| 812 |
'Dim aretePoutre As SldWorks.Edge
|
| 813 |
|
| 814 |
|
| 815 |
''For b = 0 To 1
|
| 816 |
''If Not faceinterne(b) Is Nothing Then
|
| 817 |
'b = 0
|
| 818 |
'While faceinterne(b) Is Nothing
|
| 819 |
' b += 1
|
| 820 |
'End While
|
| 821 |
|
| 822 |
'vEdges = faceinterne(b).GetEdges
|
| 823 |
'For Each Arete In vEdges
|
| 824 |
' If Distance(Arete.GetStartVertex, inter.x, inter.y, inter.z) < Epsilon Then swSommet = Arete.GetStartVertex : Exit For
|
| 825 |
' If Distance(Arete.GetEndVertex, inter.x, inter.y, inter.z) < Epsilon Then swSommet = Arete.GetEndVertex : Exit For
|
| 826 |
'Next
|
| 827 |
|
| 828 |
'Dim T As Double
|
| 829 |
'Dim xyz(2) As Double
|
| 830 |
'Dim g As Integer
|
| 831 |
'Dim courbe As SldWorks.Curve
|
| 832 |
|
| 833 |
'T = poutre.GetT(inter.x, inter.y, inter.z)
|
| 834 |
|
| 835 |
'vEdges = swSommet.GetEdges
|
| 836 |
|
| 837 |
'T -= 10000 * Epsilon
|
| 838 |
|
| 839 |
'For g = 0 To UBound(vEdges) ' boucle pas optimisée en vitesse
|
| 840 |
' Arete = vEdges(g)
|
| 841 |
' If poutre.Evaluer(T, xyz) Then
|
| 842 |
' courbe = Arete.GetCurve
|
| 843 |
' If Distance(courbe, xyz(0), xyz(1), xyz(2)) < Epsilon Then aretePoutre = Arete
|
| 844 |
' ElseIf poutre.Evaluer(T + 20000 * Epsilon, xyz) Then
|
| 845 |
' courbe = Arete.GetCurve
|
| 846 |
' If Distance(courbe, xyz(0), xyz(1), xyz(2)) < Epsilon Then aretePoutre = Arete ' la distance devrait être entre la droite (et non l'arête) et le point.
|
| 847 |
' End If
|
| 848 |
'Next g
|
| 849 |
|
| 850 |
|
| 851 |
'If aretePoutre Is Nothing Then
|
| 852 |
' ' putain d'enfoiré de merde!!!! on trouve pas la courbe de la poutre. alors on sort avec dignité!
|
| 853 |
' Exit Sub
|
| 854 |
' ' anyway on avait dit en réunion de ne pas mettre de minipoutres...
|
| 855 |
'End If
|
| 856 |
|
| 857 |
|
| 858 |
'' on a l'arète de la poutre, avec la boucle de la face on prend une arète avant et une arête après.
|
| 859 |
'Dim swBoucle As SldWorks.Loop2
|
| 860 |
'Dim AreteAvant As SldWorks.Edge, AreteSuivant As SldWorks.Edge, areteTest As SldWorks.Edge
|
| 861 |
'Dim varete As Object
|
| 862 |
'Dim Mini1 As SldWorks.Edge, Mini2 As SldWorks.Edge, Mini3 As SldWorks.Edge, Mini4 As SldWorks.Edge
|
| 863 |
|
| 864 |
'Dim j As Integer
|
| 865 |
|
| 866 |
'If Not faceinterne(0) Is Nothing Then
|
| 867 |
' swBoucle = faceinterne(0).GetFirstLoop ' devrait y en avoir juste une...
|
| 868 |
' varete = swBoucle.GetEdges()
|
| 869 |
|
| 870 |
' For j = 0 To UBound(varete)
|
| 871 |
' areteTest = varete(j)
|
| 872 |
' If areteTest Is aretePoutre Then
|
| 873 |
' If j <> 0 Then Mini1 = varete(j - 1) Else Mini1 = varete(UBound(varete))
|
| 874 |
' If j <> UBound(varete) Then Mini2 = varete(j + 1) Else Mini2 = varete(0)
|
| 875 |
' End If
|
| 876 |
' Next j
|
| 877 |
'End If
|
| 878 |
|
| 879 |
'If Not faceinterne(1) Is Nothing Then
|
| 880 |
' swBoucle = faceinterne(1).GetFirstLoop ' devrait y en avoir juste une...
|
| 881 |
' varete = swBoucle.GetEdges()
|
| 882 |
|
| 883 |
' For j = 0 To UBound(varete)
|
| 884 |
' areteTest = varete(j)
|
| 885 |
' If areteTest Is aretePoutre Then
|
| 886 |
' If j <> 0 Then Mini3 = varete(j - 1) Else Mini3 = varete(UBound(varete))
|
| 887 |
' If j <> UBound(varete) Then Mini4 = varete(j + 1) Else Mini4 = varete(0)
|
| 888 |
' End If
|
| 889 |
' Next j
|
| 890 |
'End If
|
| 891 |
'If Not Mini1 Is Nothing Then
|
| 892 |
' swEnt = Mini1
|
| 893 |
' If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
|
| 894 |
'End If
|
| 895 |
|
| 896 |
'If Not Mini2 Is Nothing Then
|
| 897 |
' swEnt = Mini2
|
| 898 |
' If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
|
| 899 |
'End If
|
| 900 |
|
| 901 |
'If Not Mini3 Is Nothing Then
|
| 902 |
' swEnt = Mini3
|
| 903 |
' If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
|
| 904 |
'End If
|
| 905 |
|
| 906 |
'If Not Mini4 Is Nothing Then
|
| 907 |
' swEnt = Mini4
|
| 908 |
' If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
|
| 909 |
'End If
|
| 910 |
Next MeFace
|
| 911 |
|
| 912 |
|
| 913 |
swModel.SetInferenceMode(True) ' ne pas mettre de contraintes par défaut
|
| 914 |
'swModel.SetAddToDB(False)
|
| 915 |
'swModel.SetDisplayWhenAdded(True) ' accélérer les performances
|
| 916 |
|
| 917 |
End Sub
|
| 918 |
|
| 919 |
|
| 920 |
' sub qui coupe la face normalement, avec un X.... [cas #1]
|
| 921 |
Friend Sub CoupeX(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre)
|
| 922 |
|
| 923 |
Dim swEnt As SldWorks.Entity = Nothing
|
| 924 |
Dim Directionnel As Boolean, Flip As Boolean
|
| 925 |
Dim Faces(3) As SldWorks.Face2
|
| 926 |
Dim r(2) As Double
|
| 927 |
Dim LaSurface As SldWorks.Surface
|
| 928 |
Dim sens As Boolean
|
| 929 |
Dim p(2) As Double
|
| 930 |
Dim retour() As Double
|
| 931 |
|
| 932 |
swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
|
| 933 |
'swModel.SetAddToDB(True)
|
| 934 |
'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
|
| 935 |
|
| 936 |
|
| 937 |
' l'idée est de sélectionner le point et l'arète puis d'utiliser CreatePlanePerCurveAndPassPoint3
|
| 938 |
Dim planReference As SldWorks.RefPlane
|
| 939 |
Dim swsketch As SldWorks.Sketch
|
| 940 |
Dim swSommet As SldWorks.Vertex, swSommet2 As SldWorks.Vertex
|
| 941 |
Dim pointdeb(2) As Double, pointfin(2) As Double
|
| 942 |
|
| 943 |
'swModel.Extension.SelectByID2("", "POINTREF", inter.x, inter.y, inter.z, False, 0, Nothing, 0)
|
| 944 |
' faut vraiment sélectionner le bon point...
|
| 945 |
swSommet = poutre.swArete.GetStartVertex()
|
| 946 |
swSommet2 = poutre.swArete.GetEndVertex()
|
| 947 |
If swSommet Is Nothing Then
|
| 948 |
MsgBox("On a un cercle ou courbe sans sommets, dans coupeX, pas encore traité. Ne peut pas mettre un plan si pas de sommet")
|
| 949 |
Else
|
| 950 |
If Distance(swSommet, inter.x, inter.y, inter.z) < Epsilon Then
|
| 951 |
swEnt = swSommet
|
| 952 |
ElseIf Distance(swSommet2, inter.x, inter.y, inter.z) < Epsilon Then
|
| 953 |
swEnt = swSommet2
|
| 954 |
Else
|
| 955 |
MsgBox("Dans coupeX, l'intersection n'est pas sur un sommet. Pas encore traité. Nécessite de créer un point au coordonnées d'intersection")
|
| 956 |
End If
|
| 957 |
End If
|
| 958 |
|
| 959 |
swEnt.Select4(False, Nothing)
|
| 960 |
swEnt = poutre.swArete
|
| 961 |
swEnt.Select(True)
|
| 962 |
|
| 963 |
If Me.estPlan Or Me.estFauxPlan(inter.x, inter.y, inter.z) Then
|
| 964 |
' si la coque est plane alors on projette le plan de référence des deux cotés, sinon on doit le décaler vers le bas
|
| 965 |
planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
|
| 966 |
Directionnel = False
|
| 967 |
Flip = False
|
| 968 |
ElseIf Me.estCylindre Then
|
| 969 |
' on a un cylindre, on ne projette pas des 2 cotés. On créé un plan, puis un autre plus bas pour ensuite projeter d'un seul coté.
|
| 970 |
Dim PlanDessus As SldWorks.RefPlane
|
| 971 |
Dim Rayon As Double, L As Double, B As Double, phi As Double, dist As Double, temp1 As Double, temp2 As Double
|
| 972 |
Dim u(2) As Double, v(2) As Double
|
| 973 |
PlanDessus = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
|
| 974 |
temp1 = poutre.GetD1
|
| 975 |
temp2 = poutre.GetD2
|
| 976 |
L = Math.Sqrt(temp1 * temp1 + temp2 * temp2)
|
| 977 |
Rayon = Me.GetRayonCylindre()
|
| 978 |
u = poutre.GetOrientation(inter.x, inter.y, inter.z)
|
| 979 |
v = Me.GetNormale(inter.x, inter.y, inter.z)
|
| 980 |
phi = -(Math.Acos(Outils_Math.cosdir(u, v)))
|
| 981 |
B = Math.Abs(L / 2 * Math.Sin(phi))
|
| 982 |
dist = Rayon - Math.Sqrt(Rayon * Rayon - ((L / 2) * (L / 2))) + B
|
| 983 |
If dist < 0 Then MsgBox("Gros problème pour couper le cylindre, la poutre est plus grosse!!!!!!", MsgBoxStyle.Critical) : Exit Sub
|
| 984 |
|
| 985 |
swEnt = PlanDessus
|
| 986 |
swEnt.Select(False)
|
| 987 |
Directionnel = True
|
| 988 |
|
| 989 |
Flip = Flipper(PlanDessus, inter)
|
| 990 |
|
| 991 |
planReference = swModel.CreatePlaneAtOffset3(dist * 2, Flip, True)
|
| 992 |
Else
|
| 993 |
MsgBox("La coque n'est ni un cylindre, ni un plan" & vbCr & "Le résultat n'est pas certain...", MsgBoxStyle.Information, "Avertissement")
|
| 994 |
planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
|
| 995 |
Directionnel = False
|
| 996 |
Flip = False
|
| 997 |
End If
|
| 998 |
|
| 999 |
|
| 1000 |
|
| 1001 |
LaSurface = Me.SwFace.GetSurface()
|
| 1002 |
sens = Me.SwFace.FaceInSurfaceSense()
|
| 1003 |
|
| 1004 |
' skx est la coordonnée du point de ref en coord de sketch, Rx est le point de référence dans le repère global.
|
| 1005 |
Dim i As Integer, MettreFI As Boolean
|
| 1006 |
Dim swFeat As SldWorks.Feature
|
| 1007 |
|
| 1008 |
For i = 0 To 1
|
| 1009 |
|
| 1010 |
swEnt = planReference
|
| 1011 |
swEnt.Select(False)
|
| 1012 |
swModel.InsertSketch2(False)
|
| 1013 |
swModel.ClearSelection2(True)
|
| 1014 |
swFeat = swModel.FeatureByPositionReverse(0)
|
| 1015 |
swModel.SelectByID(swFeat.Name, "SKETCH", 0, 0, 0)
|
| 1016 |
swModel.EditSketch()
|
| 1017 |
swsketch = swModel.GetActiveSketch2
|
| 1018 |
|
| 1019 |
p(0) = inter.x : p(1) = inter.y : p(2) = inter.z
|
| 1020 |
retour = Commun.TransfertModelSketch(swsketch, p)
|
| 1021 |
|
| 1022 |
|
| 1023 |
r = DessineSectionPoutre(poutre, retour(0), retour(1), i + 1, swsketch, inter, MettreFI)
|
| 1024 |
swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
|
| 1025 |
swModel.ClearSelection2(True)
|
| 1026 |
|
| 1027 |
Dim face As SldWorks.Face2
|
| 1028 |
For Each face In Me.lst_Faces
|
| 1029 |
swModel.ClearSelection2(True)
|
| 1030 |
swEnt = face : swEnt.Select2(False, 1)
|
| 1031 |
swEnt = swsketch : swEnt.Select2(True, 4)
|
| 1032 |
swModel.InsertSplitLineProject(Directionnel, Flip)
|
| 1033 |
Next
|
| 1034 |
|
| 1035 |
|
| 1036 |
Me.SwFace.DetachSurface()
|
| 1037 |
Me.SwFace.AttachSurface(LaSurface, sens)
|
| 1038 |
|
| 1039 |
Faces(i) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, MettreFI)
|
| 1040 |
Commun.MettreUnPoint(r(0), r(1), r(2))
|
| 1041 |
|
| 1042 |
If Faces(i) Is Nothing Then
|
| 1043 |
swEnt.Select(False)
|
| 1044 |
swModel.EditDelete()
|
| 1045 |
End If
|
| 1046 |
If Flag = 2 Then Flag = 0 : Exit For
|
| 1047 |
|
| 1048 |
Next i
|
| 1049 |
|
| 1050 |
swModel.SetInferenceMode(True)
|
| 1051 |
'swModel.SetAddToDB(False)
|
| 1052 |
'swModel.SetDisplayWhenAdded(True)
|
| 1053 |
|
| 1054 |
End Sub
|
| 1055 |
|
| 1056 |
|
| 1057 |
' Sub qui appelle le découpage de la face
|
| 1058 |
Public Sub decouper()
|
| 1059 |
|
| 1060 |
If lst_InterPoutre.Count = 0 Then Exit Sub ' sortir si on a pas d'intersection
|
| 1061 |
|
| 1062 |
|
| 1063 |
' les attributs ne sont pas updatés sur les faces (mais sur les arètes et les sommets c'est OK)
|
| 1064 |
' on mémorise l'attribut de la face et on la réapplique à la fin.
|
| 1065 |
|
| 1066 |
|
| 1067 |
Dim i As Integer
|
| 1068 |
Dim inter As InterPoutreVolume
|
| 1069 |
Dim nb1 As Integer, nb2 As Integer, nb3 As Integer, nb5 As Integer
|
| 1070 |
Dim poutre1 As SlyAretePoutre = Nothing, poutre3 As SlyAretePoutre = Nothing
|
| 1071 |
Dim lst_poutre2 As New Collection
|
| 1072 |
Dim aire As Double
|
| 1073 |
Dim poutreTest As SlyAretePoutre
|
| 1074 |
|
| 1075 |
Dim lst_coupeXinter As New Collection
|
| 1076 |
Dim lst_coupeXPoutre As New Collection
|
| 1077 |
Dim lst_coupeLinter As New Collection
|
| 1078 |
Dim lst_coupeLPoutre As New Collection
|
| 1079 |
Dim lst_coupeCinter As New Collection
|
| 1080 |
Dim lst_coupeCPoutre As New Collection
|
| 1081 |
|
| 1082 |
|
| 1083 |
For Each inter In lst_InterPoutre
|
| 1084 |
|
| 1085 |
'pour chaque intersection on peut avoir plusieurs poutres...
|
| 1086 |
For i = 1 To inter.lst_sPoutre.Count
|
| 1087 |
poutreTest = inter.lst_sPoutre.Item(i)
|
| 1088 |
Select Case CInt(inter.lst_type.Item(i))
|
| 1089 |
Case 1
|
| 1090 |
If poutreTest.GetAireCarree > aire Then poutre1 = poutreTest
|
| 1091 |
nb1 += 1
|
| 1092 |
Case 2
|
| 1093 |
lst_poutre2.Add(poutreTest)
|
| 1094 |
nb2 += 1
|
| 1095 |
Case 3
|
| 1096 |
If poutreTest.GetAireCarree > aire Then poutre3 = poutreTest
|
| 1097 |
nb3 += 1
|
| 1098 |
Case 5 ' un poutre à faceDeSection
|
| 1099 |
nb5 += 1
|
| 1100 |
Case 22
|
| 1101 |
' on fait rien, mais c'est pour éviter le msgbox du case else...
|
| 1102 |
Case Else
|
| 1103 |
MsgBox("Problème dans découper de SlyFaceCoque, le type d'intersection n'est pas reconnu", MsgBoxStyle.Critical)
|
| 1104 |
End Select
|
| 1105 |
Next i
|
| 1106 |
|
| 1107 |
|
| 1108 |
|
| 1109 |
If nb1 > 0 Then 'CoupeX(inter, poutre1) ' on coupe le x en premier
|
| 1110 |
lst_coupeXinter.Add(inter)
|
| 1111 |
lst_coupeXPoutre.Add(poutre1)
|
| 1112 |
End If
|
| 1113 |
|
| 1114 |
|
| 1115 |
For Each poutreTest In lst_poutre2 ' puis on coupe sur la longueur 'CoupeLong(inter, poutreTest)
|
| 1116 |
lst_coupeLinter.Add(inter)
|
| 1117 |
lst_coupeLPoutre.Add(poutreTest)
|
| 1118 |
Next
|
| 1119 |
|
| 1120 |
If nb3 > 0 Then 'CoupeCote(inter, poutre3) ' finalement on coupe sur les cotés
|
| 1121 |
lst_coupeCinter.Add(inter)
|
| 1122 |
lst_coupeCPoutre.Add(poutre3)
|
| 1123 |
End If
|
| 1124 |
|
| 1125 |
If nb5 = 1 And (nb1 > 0 Or nb2 > 0 Or nb3 > 0) Then
|
| 1126 |
MsgBox("Problème, on a un type d'intersection impossible dans la vraie vie!", MsgBoxStyle.Exclamation, "Design impossible à obtenir en réalité...")
|
| 1127 |
End If
|
| 1128 |
|
| 1129 |
|
| 1130 |
lst_poutre2.Clear()
|
| 1131 |
nb1 = 0 : nb2 = 0 : nb3 = 0
|
| 1132 |
|
| 1133 |
|
| 1134 |
Next inter
|
| 1135 |
|
| 1136 |
|
| 1137 |
' maintenant on a toutes les lists d'intersections. On les coupe.
|
| 1138 |
For i = 1 To lst_coupeXinter.Count
|
| 1139 |
CoupeX(lst_coupeXinter.Item(i), lst_coupeXPoutre.Item(i))
|
| 1140 |
Next
|
| 1141 |
|
| 1142 |
For i = 1 To lst_coupeLinter.Count
|
| 1143 |
CoupeLong(lst_coupeLinter.Item(i), lst_coupeLPoutre.Item(i))
|
| 1144 |
Next
|
| 1145 |
|
| 1146 |
For i = 1 To lst_coupeCinter.Count
|
| 1147 |
CoupeCote(lst_coupeCinter.Item(i), lst_coupeCPoutre.Item(i))
|
| 1148 |
Next
|
| 1149 |
If nb5 = 1 Then
|
| 1150 |
If lst_InterPoutre.Count <> 1 Then MsgBox("Plus d'une intersection du type FacedeSection....")
|
| 1151 |
CoupeFaceDeSection(lst_InterPoutre(1))
|
| 1152 |
End If
|
| 1153 |
|
| 1154 |
End Sub
|
| 1155 |
|
| 1156 |
Private Sub CoupeFaceDeSection(ByRef inter As InterPoutreVolume)
|
| 1157 |
Dim swEnt As SldWorks.Entity = Nothing
|
| 1158 |
Dim Directionnel As Boolean
|
| 1159 |
Dim Faces(3) As SldWorks.Face2
|
| 1160 |
Dim r(2) As Double
|
| 1161 |
Dim p(2) As Double
|
| 1162 |
Dim planReference As SldWorks.RefPlane = Nothing
|
| 1163 |
Dim swsketch As SldWorks.Sketch
|
| 1164 |
Dim pointdeb(2) As Double, pointfin(2) As Double
|
| 1165 |
Dim sketchline As SldWorks.SketchLine
|
| 1166 |
Dim swFeat As SldWorks.Feature
|
| 1167 |
|
| 1168 |
|
| 1169 |
swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
|
| 1170 |
|
| 1171 |
swEnt = Me.SwFace
|
| 1172 |
swEnt.Select(False)
|
| 1173 |
swModel.InsertSketch2(False)
|
| 1174 |
swsketch = swModel.GetActiveSketch2
|
| 1175 |
|
| 1176 |
' dessin de la forme à faire...
|
| 1177 |
|
| 1178 |
Dim xyzc() As Double, xyz(2) As Double
|
| 1179 |
xyz(0) = inter.x : xyz(1) = inter.y : xyz(2) = inter.z
|
| 1180 |
xyzc = Commun.TransfertModelSketch(swsketch, xyz)
|
| 1181 |
|
| 1182 |
sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) + Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0)
|
| 1183 |
sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) - Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0)
|
| 1184 |
swModel.CreateArc2(xyzc(0), xyzc(1), 0, xyzc(0) + Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0, xyzc(0) - Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0, 1) ' le dernier param est la direction. 1 ou -1
|
| 1185 |
|
| 1186 |
swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
|
| 1187 |
swModel.ClearSelection2(True)
|
| 1188 |
|
| 1189 |
swEnt = Me.SwFace : swEnt.Select2(False, 1)
|
| 1190 |
swEnt = swsketch : swEnt.Select2(True, 4)
|
| 1191 |
swModel.InsertSplitLineProject(Directionnel, False)
|
| 1192 |
|
| 1193 |
|
| 1194 |
' flagger les 2 faces comme faces Internes.
|
| 1195 |
Dim vface As Object
|
| 1196 |
Dim face As SldWorks.Face2
|
| 1197 |
Dim attr As SldWorks.Attribute
|
| 1198 |
swFeat = swModel.FeatureByPositionReverse(0)
|
| 1199 |
Try
|
| 1200 |
vface = swFeat.GetFaces
|
| 1201 |
For Each face In vface
|
| 1202 |
'**************
|
| 1203 |
Dim nom2 As String = "FaceInterne" & no
|
| 1204 |
swEnt = face
|
| 1205 |
attr = swEnt.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
|
| 1206 |
If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom2, 0, 2) ' 0 = swThisconfig
|
| 1207 |
While attr Is Nothing
|
| 1208 |
no += 1
|
| 1209 |
nom2 = "FaceInterne" & CStr(no)
|
| 1210 |
attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom2, 0, 2)
|
| 1211 |
End While
|
| 1212 |
GererDossiers("FaceInternes", nom2)
|
| 1213 |
no += 1
|
| 1214 |
|
| 1215 |
|
| 1216 |
'**************
|
| 1217 |
Me.AjouterFace(face)
|
| 1218 |
Next face
|
| 1219 |
Catch
|
| 1220 |
' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
|
| 1221 |
' on doit donc le déterminer anyway
|
| 1222 |
End Try
|
| 1223 |
|
| 1224 |
' si ça ne touche pas à la face
|
| 1225 |
If Not Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
|
| 1226 |
AjouterMiniPoutresSurFaceInterne(inter.lst_sPoutre.Item(1), face, inter.x, inter.y, inter.z)
|
| 1227 |
'MsgBox("On ajoute une mini-poutre entre la poutre " & inter.lst_sPoutre.Item(1).nom & vbCr & " et le point ( " & Format(inter.x * 1000, "0000") & " , " & Format(inter.y * 1000, "0000") & " , " & Format(inter.y * 1000, "0000") & " )")
|
| 1228 |
End If
|
| 1229 |
|
| 1230 |
swModel.SetInferenceMode(True)
|
| 1231 |
|
| 1232 |
End Sub
|
| 1233 |
|
| 1234 |
|
| 1235 |
Friend Overridable Sub chercherAttributs()
|
| 1236 |
Dim swEnt As SldWorks.Entity
|
| 1237 |
Dim attr As SldWorks.Attribute
|
| 1238 |
|
| 1239 |
swEnt = Me.SwFace
|
| 1240 |
|
| 1241 |
attr = swEnt.FindAttribute(Intersections.DefAttrConditionLimite, 0)
|
| 1242 |
If Not attr Is Nothing Then Me.AttributCL = attr : attr = Nothing
|
| 1243 |
|
| 1244 |
'attr = swent.findattribute(intersections.DefAttrFaceInterne,0) ' ne devrait pas s'entrecouper...
|
| 1245 |
|
| 1246 |
End Sub
|
| 1247 |
|
| 1248 |
Private Function Flipper(ByRef PlanDessus As SldWorks.RefPlane, ByRef inter As InterPoutreVolume) As Boolean
|
| 1249 |
' function qui dit si l'on doit flipper le sens du plan de référence.
|
| 1250 |
' calcul de la direction à prendre
|
| 1251 |
Dim retval As Object
|
| 1252 |
Dim ret(8) As Double
|
| 1253 |
Dim ret2(6) As Double
|
| 1254 |
Dim normalePlan(2) As Double
|
| 1255 |
Dim OV(2) As Double
|
| 1256 |
Dim swSurf As SldWorks.Surface
|
| 1257 |
|
| 1258 |
retval = PlanDessus.GetRefPlaneParams()
|
| 1259 |
ret = retval
|
| 1260 |
normalePlan(0) = ret(6) : normalePlan(1) = ret(7) : normalePlan(2) = ret(8)
|
| 1261 |
swSurf = Me.lst_Faces.Item(1).GetSurface
|
| 1262 |
retval = swSurf.CylinderParams() ' 7 doubles, les 3 premiers sont l'origine
|
| 1263 |
ret2 = retval
|
| 1264 |
OV(0) = ret2(0) - inter.x : OV(1) = ret2(1) - inter.y : OV(2) = ret2(2) - inter.z
|
| 1265 |
|
| 1266 |
' l'angle est le produit scalaire divisé par la norme des 2 vecteurs
|
| 1267 |
Dim temp As Double = Outils_Math.Angle2Vecteurs(OV, normalePlan)
|
| 1268 |
If (temp < Pi / 2) And (temp > -Pi / 2) Then Return False Else Return True
|
| 1269 |
|
| 1270 |
End Function
|
| 1271 |
|
| 1272 |
|
| 1273 |
Private Function DessineSectionPoutre(ByRef Poutre As SlyAretePoutre, ByVal TranslationX As Double, ByVal TranslationY As Double, ByVal numero As Integer, ByRef swSketch As SldWorks.Sketch, ByRef inter As InterPoutreVolume, ByRef MettreFI As Boolean) As Double()
|
| 1274 |
' le sketch est déjà inséré, il faut juste mettre des swmodel.line ou autre
|
| 1275 |
' doit retourner r() qui est un point situé à l'intérieur de la coupe
|
| 1276 |
Dim sketchline As SldWorks.SketchSegment
|
| 1277 |
Dim longueur As Double
|
| 1278 |
Dim r(2) As Double
|
| 1279 |
Dim sk(1) As Double
|
| 1280 |
Dim i As Integer
|
| 1281 |
Dim Ligne() As Double = Nothing ' liste des lignes (4 valeurs par ligne)
|
| 1282 |
Dim pt3() As Double
|
| 1283 |
Dim Nomsection As String
|
| 1284 |
|
| 1285 |
MettreFI = True
|
| 1286 |
|
| 1287 |
' on doit activer le sketch avant d'utiliser la fonction getactivesketch
|
| 1288 |
pt3 = Poutre.GetPoint3
|
| 1289 |
longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
|
| 1290 |
Dim IP(2) As Double ' IP est le vecteur directionnel
|
| 1291 |
IP(0) = pt3(0) - inter.x : IP(1) = pt3(1) - inter.y : IP(2) = pt3(2) - inter.z
|
| 1292 |
|
| 1293 |
|
| 1294 |
pt3 = Commun.TransfertModelSketch(swSketch, pt3)
|
| 1295 |
longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
|
| 1296 |
|
| 1297 |
Nomsection = Poutre.GetNomSection
|
| 1298 |
If Nomsection = "Rectangle" Or Nomsection = " Rectangle générique" Then ' un rectangle
|
| 1299 |
Select Case numero
|
| 1300 |
Case 1
|
| 1301 |
Dim P(2, 1) As Double
|
| 1302 |
P(0, 0) = 0
|
| 1303 |
P(0, 1) = 0
|
| 1304 |
P(1, 0) = Poutre.GetD1 / 2
|
| 1305 |
P(1, 1) = -Poutre.GetD2 / 2
|
| 1306 |
P(2, 0) = Poutre.GetD1 / 2
|
| 1307 |
P(2, 1) = Poutre.GetD2 / 2
|
| 1308 |
|
| 1309 |
ReDim Ligne(11)
|
| 1310 |
pt3(0) -= TranslationX
|
| 1311 |
pt3(1) -= TranslationY
|
| 1312 |
For i = 0 To 2
|
| 1313 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1314 |
P(i, 0) += TranslationX
|
| 1315 |
P(i, 1) += TranslationY
|
| 1316 |
Next i
|
| 1317 |
|
| 1318 |
For i = 0 To 1
|
| 1319 |
Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
|
| 1320 |
Next i
|
| 1321 |
Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(0, 0) : Ligne(11) = P(0, 1)
|
| 1322 |
|
| 1323 |
r(0) = inter.x + 5000 * Epsilon * IP(0)
|
| 1324 |
r(1) = inter.y + 5000 * Epsilon * IP(1)
|
| 1325 |
r(2) = inter.z + 5000 * Epsilon * IP(2)
|
| 1326 |
|
| 1327 |
Case 2
|
| 1328 |
ReDim Ligne(19)
|
| 1329 |
|
| 1330 |
Dim p(4, 1) As Double
|
| 1331 |
p(0, 0) = 0
|
| 1332 |
p(0, 1) = 0
|
| 1333 |
p(1, 0) = Poutre.GetD1 / 2
|
| 1334 |
p(1, 1) = Poutre.GetD2 / 2
|
| 1335 |
p(2, 0) = -Poutre.GetD1 / 2
|
| 1336 |
p(2, 1) = Poutre.GetD2 / 2
|
| 1337 |
p(3, 0) = -Poutre.GetD1 / 2
|
| 1338 |
p(3, 1) = -Poutre.GetD2 / 2
|
| 1339 |
p(4, 0) = Poutre.GetD1 / 2
|
| 1340 |
p(4, 1) = -Poutre.GetD2 / 2
|
| 1341 |
|
| 1342 |
|
| 1343 |
pt3(0) -= TranslationX
|
| 1344 |
pt3(1) -= TranslationY
|
| 1345 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1346 |
For i = 0 To 4
|
| 1347 |
Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
|
| 1348 |
p(i, 0) += TranslationX
|
| 1349 |
p(i, 1) += TranslationY
|
| 1350 |
Next i
|
| 1351 |
|
| 1352 |
For i = 0 To 3
|
| 1353 |
Ligne(i * 4) = p(i, 0) : Ligne(i * 4 + 1) = p(i, 1) : Ligne(i * 4 + 2) = p(i + 1, 0) : Ligne(i * 4 + 3) = p(i + 1, 1)
|
| 1354 |
Next i
|
| 1355 |
Ligne(16) = p(4, 0) : Ligne(17) = p(4, 1) : Ligne(18) = p(0, 0) : Ligne(19) = p(0, 1)
|
| 1356 |
r(0) = inter.x - 5000 * Epsilon * IP(0)
|
| 1357 |
r(1) = inter.y - 5000 * Epsilon * IP(1)
|
| 1358 |
r(2) = inter.z - 5000 * Epsilon * IP(2)
|
| 1359 |
|
| 1360 |
End Select
|
| 1361 |
MettreFI = True
|
| 1362 |
ElseIf Left(Nomsection, 2) = "ST" Or Nomsection = " Tube carré générique" Then ' tube carré troué
|
| 1363 |
Dim P(3, 1) As Double
|
| 1364 |
Select Case numero
|
| 1365 |
Case 1
|
| 1366 |
P(0, 0) = Poutre.GetD1 / 2
|
| 1367 |
P(0, 1) = -Poutre.GetD2 / 2
|
| 1368 |
P(1, 0) = P(0, 0)
|
| 1369 |
P(1, 1) = -P(0, 1)
|
| 1370 |
P(2, 0) = -P(0, 0)
|
| 1371 |
P(2, 1) = P(1, 1)
|
| 1372 |
P(3, 0) = P(2, 0)
|
| 1373 |
P(3, 1) = P(0, 1)
|
| 1374 |
|
| 1375 |
r(0) = P(0, 0) - 1000 * Epsilon
|
| 1376 |
r(1) = 0 : r(2) = 0
|
| 1377 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1378 |
r(0) += TranslationX
|
| 1379 |
r(1) += TranslationY
|
| 1380 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1381 |
|
| 1382 |
pt3(0) -= TranslationX
|
| 1383 |
pt3(1) -= TranslationY
|
| 1384 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1385 |
For i = 0 To 3
|
| 1386 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1387 |
P(i, 0) += TranslationX
|
| 1388 |
P(i, 1) += TranslationY
|
| 1389 |
Next i
|
| 1390 |
|
| 1391 |
ReDim Ligne(15)
|
| 1392 |
Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
|
| 1393 |
Ligne(4) = P(1, 0) : Ligne(5) = P(1, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
|
| 1394 |
Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(3, 0) : Ligne(11) = P(3, 1)
|
| 1395 |
Ligne(12) = P(3, 0) : Ligne(13) = P(3, 1) : Ligne(14) = P(0, 0) : Ligne(15) = P(0, 1)
|
| 1396 |
MettreFI = False
|
| 1397 |
|
| 1398 |
Case 2
|
| 1399 |
P(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
|
| 1400 |
P(0, 1) = -Poutre.GetD2 / 2 + Poutre.GetD3
|
| 1401 |
P(1, 0) = P(0, 0)
|
| 1402 |
P(1, 1) = -P(0, 1)
|
| 1403 |
P(2, 0) = -P(1, 0)
|
| 1404 |
P(2, 1) = P(1, 1)
|
| 1405 |
P(3, 0) = P(2, 0)
|
| 1406 |
P(3, 1) = P(0, 1)
|
| 1407 |
|
| 1408 |
r(0) = P(0, 0) + 1000 * Epsilon
|
| 1409 |
r(1) = 0 : r(2) = 0
|
| 1410 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1411 |
r(0) += TranslationX
|
| 1412 |
r(1) += TranslationY
|
| 1413 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1414 |
|
| 1415 |
pt3(0) -= TranslationX
|
| 1416 |
pt3(1) -= TranslationY
|
| 1417 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1418 |
For i = 0 To 3
|
| 1419 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1420 |
P(i, 0) += TranslationX
|
| 1421 |
P(i, 1) += TranslationY
|
| 1422 |
Next i
|
| 1423 |
|
| 1424 |
ReDim Ligne(15)
|
| 1425 |
Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
|
| 1426 |
Ligne(4) = P(1, 0) : Ligne(5) = P(1, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
|
| 1427 |
Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(3, 0) : Ligne(11) = P(3, 1)
|
| 1428 |
Ligne(12) = P(3, 0) : Ligne(13) = P(3, 1) : Ligne(14) = P(0, 0) : Ligne(15) = P(0, 1)
|
| 1429 |
|
| 1430 |
MettreFI = True ' lorsque l'on sort on met une face interne
|
| 1431 |
|
| 1432 |
End Select
|
| 1433 |
|
| 1434 |
|
| 1435 |
ElseIf Left(Nomsection, 1) = "S" Or Nomsection = " Poutre en I générique" Then ' poutre en I de type S
|
| 1436 |
Dim P(8, 1) As Double
|
| 1437 |
|
| 1438 |
Select Case numero
|
| 1439 |
Case 1
|
| 1440 |
Dim d As Double
|
| 1441 |
d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
|
| 1442 |
|
| 1443 |
P(0, 0) = 0
|
| 1444 |
P(0, 1) = 0
|
| 1445 |
P(1, 0) = -d
|
| 1446 |
P(1, 1) = -Poutre.GetD4 / 2.0R
|
| 1447 |
P(2, 0) = (Poutre.GetD1 / 2) - Poutre.GetD3
|
| 1448 |
P(2, 1) = -Poutre.GetD4 / 2.0R
|
| 1449 |
P(3, 0) = P(2, 0)
|
| 1450 |
P(3, 1) = -Poutre.GetD2 / 2
|
| 1451 |
P(4, 0) = Poutre.GetD1 / 2
|
| 1452 |
P(4, 1) = P(3, 1)
|
| 1453 |
P(5, 0) = P(4, 0)
|
| 1454 |
P(5, 1) = -P(4, 1)
|
| 1455 |
P(6, 0) = P(3, 0)
|
| 1456 |
P(6, 1) = -P(3, 1)
|
| 1457 |
P(7, 0) = P(2, 0)
|
| 1458 |
P(7, 1) = -P(2, 1)
|
| 1459 |
P(8, 0) = P(1, 0)
|
| 1460 |
P(8, 1) = -P(1, 1)
|
| 1461 |
|
| 1462 |
pt3(0) -= TranslationX
|
| 1463 |
pt3(1) -= TranslationY
|
| 1464 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1465 |
For i = 0 To 8
|
| 1466 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1467 |
P(i, 0) += TranslationX
|
| 1468 |
P(i, 1) += TranslationY
|
| 1469 |
Next i
|
| 1470 |
|
| 1471 |
ReDim Ligne(35)
|
| 1472 |
For i = 0 To 7
|
| 1473 |
Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
|
| 1474 |
Next i
|
| 1475 |
Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
|
| 1476 |
r(0) = inter.x + 5000 * Epsilon * IP(0)
|
| 1477 |
r(1) = inter.y + 5000 * Epsilon * IP(1)
|
| 1478 |
r(2) = inter.z + 5000 * Epsilon * IP(2)
|
| 1479 |
Case 2
|
| 1480 |
|
| 1481 |
Dim d As Double
|
| 1482 |
d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
|
| 1483 |
|
| 1484 |
P(0, 0) = 0
|
| 1485 |
P(0, 1) = 0
|
| 1486 |
|
| 1487 |
P(1, 0) = -d
|
| 1488 |
P(1, 1) = -Poutre.GetD4 / 2.0R
|
| 1489 |
P(2, 0) = -((Poutre.GetD1 / 2) - Poutre.GetD3)
|
| 1490 |
P(2, 1) = -Poutre.GetD4 / 2.0R
|
| 1491 |
P(3, 0) = P(2, 0)
|
| 1492 |
P(3, 1) = -Poutre.GetD2 / 2
|
| 1493 |
P(4, 0) = -Poutre.GetD1 / 2
|
| 1494 |
P(4, 1) = P(3, 1)
|
| 1495 |
P(5, 0) = P(4, 0)
|
| 1496 |
P(5, 1) = -P(4, 1)
|
| 1497 |
P(6, 0) = P(3, 0)
|
| 1498 |
P(6, 1) = -P(3, 1)
|
| 1499 |
P(7, 0) = P(2, 0)
|
| 1500 |
P(7, 1) = -P(2, 1)
|
| 1501 |
P(8, 0) = P(1, 0)
|
| 1502 |
P(8, 1) = -P(1, 1)
|
| 1503 |
|
| 1504 |
pt3(0) -= TranslationX
|
| 1505 |
pt3(1) -= TranslationY
|
| 1506 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1507 |
For i = 0 To 8
|
| 1508 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1509 |
P(i, 0) += TranslationX
|
| 1510 |
P(i, 1) += TranslationY
|
| 1511 |
Next i
|
| 1512 |
|
| 1513 |
ReDim Ligne(35)
|
| 1514 |
For i = 0 To 7
|
| 1515 |
Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
|
| 1516 |
Next i
|
| 1517 |
Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
|
| 1518 |
|
| 1519 |
r(0) = inter.x - 5000 * Epsilon * IP(0)
|
| 1520 |
r(1) = inter.y - 5000 * Epsilon * IP(1)
|
| 1521 |
r(2) = inter.z - 5000 * Epsilon * IP(2)
|
| 1522 |
|
| 1523 |
End Select
|
| 1524 |
MettreFI = True
|
| 1525 |
|
| 1526 |
ElseIf Left(Nomsection, 4) = "Tube" Or Nomsection = " Tuyau (Pipe) générique" Then ' le tube rond
|
| 1527 |
Dim p(4, 1) As Double
|
| 1528 |
p(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
|
| 1529 |
p(0, 1) = 0
|
| 1530 |
p(1, 0) = Poutre.GetD1 / 2
|
| 1531 |
p(1, 1) = 0
|
| 1532 |
p(2, 0) = -p(0, 0)
|
| 1533 |
p(2, 1) = 0
|
| 1534 |
p(3, 0) = -p(1, 0)
|
| 1535 |
p(3, 1) = 0
|
| 1536 |
p(4, 0) = 0
|
| 1537 |
p(4, 1) = 0
|
| 1538 |
|
| 1539 |
Select Case numero
|
| 1540 |
Case 1
|
| 1541 |
|
| 1542 |
r(0) = 0
|
| 1543 |
r(1) = Poutre.GetD1 / 2 - Poutre.GetD3 / 2 : r(2) = 0
|
| 1544 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1545 |
r(0) += TranslationX
|
| 1546 |
r(1) += TranslationY
|
| 1547 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1548 |
|
| 1549 |
pt3(0) -= TranslationX
|
| 1550 |
pt3(1) -= TranslationY
|
| 1551 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1552 |
For i = 0 To 4
|
| 1553 |
Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
|
| 1554 |
p(i, 0) += TranslationX
|
| 1555 |
p(i, 1) += TranslationY
|
| 1556 |
Next i
|
| 1557 |
|
| 1558 |
ReDim Ligne(7)
|
| 1559 |
Ligne(0) = p(0, 0) : Ligne(1) = p(0, 1) : Ligne(2) = p(1, 0) : Ligne(3) = p(1, 1)
|
| 1560 |
Ligne(4) = p(2, 0) : Ligne(5) = p(2, 1) : Ligne(6) = p(3, 0) : Ligne(7) = p(3, 1)
|
| 1561 |
swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(1, 0), p(1, 1), 0, p(3, 0), p(3, 1), 0, 1)
|
| 1562 |
swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(0, 0), p(0, 1), 0, p(2, 0), p(2, 1), 0, 1)
|
| 1563 |
MettreFI = True
|
| 1564 |
'Flag = 2
|
| 1565 |
Case 2
|
| 1566 |
|
| 1567 |
r(0) = 0
|
| 1568 |
r(1) = -Poutre.GetD1 / 2 + Poutre.GetD3 / 2 : r(2) = 0
|
| 1569 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1570 |
r(0) += TranslationX
|
| 1571 |
r(1) += TranslationY
|
| 1572 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1573 |
|
| 1574 |
pt3(0) -= TranslationX
|
| 1575 |
pt3(1) -= TranslationY
|
| 1576 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1577 |
For i = 0 To 4
|
| 1578 |
Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
|
| 1579 |
p(i, 0) += TranslationX
|
| 1580 |
p(i, 1) += TranslationY
|
| 1581 |
Next i
|
| 1582 |
|
| 1583 |
ReDim Ligne(7)
|
| 1584 |
Ligne(0) = p(0, 0) : Ligne(1) = p(0, 1) : Ligne(2) = p(1, 0) : Ligne(3) = p(1, 1)
|
| 1585 |
Ligne(4) = p(2, 0) : Ligne(5) = p(2, 1) : Ligne(6) = p(3, 0) : Ligne(7) = p(3, 1)
|
| 1586 |
swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(1, 0), p(1, 1), 0, p(3, 0), p(3, 1), 0, -1)
|
| 1587 |
swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(0, 0), p(0, 1), 0, p(2, 0), p(2, 1), 0, -1)
|
| 1588 |
'MettreFI = True ' lorsque l'on sort on met une face interne
|
| 1589 |
MettreFI = False
|
| 1590 |
Me.Flag = 2
|
| 1591 |
'Case 1 ' le cercle extérieur
|
| 1592 |
' swModel.CreateCircleByRadius2(TranslationX, TranslationY, 0, Poutre.GetD1 / 2)
|
| 1593 |
' MettreFI = False
|
| 1594 |
' r(0) = 0 : r(1) = 0 : r(2) = 0
|
| 1595 |
' r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1596 |
'Case 2
|
| 1597 |
' swModel.CreateCircleByRadius2(TranslationX, TranslationY, 0, (Poutre.GetD1 / 2) - Poutre.GetD3)
|
| 1598 |
' r(0) = (Poutre.GetD1 / 2 - (Poutre.GetD3 / 2))
|
| 1599 |
' r(1) = 0 : r(2) = 0
|
| 1600 |
' r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1601 |
' MettreFI = True
|
| 1602 |
End Select
|
| 1603 |
|
| 1604 |
ElseIf Left(Nomsection, 1) = "C" Or Nomsection = " Poutre en C générique" Then ' le channel
|
| 1605 |
Dim P(7, 1) As Double
|
| 1606 |
|
| 1607 |
Select Case numero
|
| 1608 |
Case 1 ' le C au complet
|
| 1609 |
|
| 1610 |
P(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
|
| 1611 |
P(0, 1) = Poutre.GetD5
|
| 1612 |
P(1, 0) = P(0, 0)
|
| 1613 |
P(1, 1) = Poutre.GetD5 + Poutre.GetD4 - Poutre.GetD2
|
| 1614 |
P(2, 0) = Poutre.GetD1 / 2
|
| 1615 |
P(2, 1) = P(1, 1)
|
| 1616 |
P(3, 0) = P(2, 0)
|
| 1617 |
P(3, 1) = P(1, 1) + Poutre.GetD2
|
| 1618 |
P(4, 0) = -P(3, 0)
|
| 1619 |
P(4, 1) = P(3, 1)
|
| 1620 |
P(5, 0) = P(4, 0)
|
| 1621 |
P(5, 1) = P(1, 1)
|
| 1622 |
P(6, 0) = -P(1, 0)
|
| 1623 |
P(6, 1) = P(5, 1)
|
| 1624 |
P(7, 0) = -P(0, 0)
|
| 1625 |
P(7, 1) = P(0, 1)
|
| 1626 |
|
| 1627 |
r(0) = P(0, 0) + 1000 * Epsilon
|
| 1628 |
r(1) = 0 : r(2) = 0
|
| 1629 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1630 |
r(0) += TranslationX
|
| 1631 |
r(1) += TranslationY
|
| 1632 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1633 |
|
| 1634 |
pt3(0) -= TranslationX
|
| 1635 |
pt3(1) -= TranslationY
|
| 1636 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1637 |
For i = 0 To 7
|
| 1638 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1639 |
P(i, 0) += TranslationX
|
| 1640 |
P(i, 1) += TranslationY
|
| 1641 |
Next i
|
| 1642 |
|
| 1643 |
ReDim Ligne(35)
|
| 1644 |
For i = 0 To 6
|
| 1645 |
Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
|
| 1646 |
Next i
|
| 1647 |
Ligne(28) = P(7, 0) : Ligne(29) = P(7, 1) : Ligne(30) = P(0, 0) : Ligne(31) = P(0, 1)
|
| 1648 |
|
| 1649 |
MettreFI = False
|
| 1650 |
Me.Flag = 2
|
| 1651 |
Case 2
|
| 1652 |
MettreFI = False ' Attention, peut planter à cause de ça.
|
| 1653 |
End Select
|
| 1654 |
|
| 1655 |
ElseIf Left(Nomsection, 1) = "L" Or Nomsection = " Poutre en L générique" Then ' l'Angle en L
|
| 1656 |
Dim P(5, 1) As Double
|
| 1657 |
|
| 1658 |
Select Case numero
|
| 1659 |
Case 1 ' le C au complet
|
| 1660 |
|
| 1661 |
P(0, 0) = -Poutre.GetD5 + Poutre.GetD1
|
| 1662 |
P(0, 1) = -Poutre.GetD6 + Poutre.GetD4
|
| 1663 |
P(1, 0) = -Poutre.GetD5 + Poutre.GetD3
|
| 1664 |
P(1, 1) = P(0, 1)
|
| 1665 |
P(2, 0) = P(1, 0)
|
| 1666 |
P(2, 1) = -Poutre.GetD6 + Poutre.GetD2
|
| 1667 |
P(3, 0) = -Poutre.GetD5
|
| 1668 |
P(3, 1) = P(2, 1)
|
| 1669 |
P(4, 0) = P(3, 0)
|
| 1670 |
P(4, 1) = -Poutre.GetD6
|
| 1671 |
P(5, 0) = P(0, 0)
|
| 1672 |
P(5, 1) = P(4, 1)
|
| 1673 |
|
| 1674 |
r(0) = P(1, 0) - 1000 * Epsilon
|
| 1675 |
r(1) = 0 : r(2) = 0
|
| 1676 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1677 |
r(0) += TranslationX
|
| 1678 |
r(1) += TranslationY
|
| 1679 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1680 |
|
| 1681 |
pt3(0) -= TranslationX
|
| 1682 |
pt3(1) -= TranslationY
|
| 1683 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1684 |
For i = 0 To 5
|
| 1685 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1686 |
P(i, 0) += TranslationX
|
| 1687 |
P(i, 1) += TranslationY
|
| 1688 |
Next i
|
| 1689 |
|
| 1690 |
ReDim Ligne(35)
|
| 1691 |
For i = 0 To 4
|
| 1692 |
Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
|
| 1693 |
Next i
|
| 1694 |
Ligne(20) = P(5, 0) : Ligne(21) = P(5, 1) : Ligne(22) = P(0, 0) : Ligne(23) = P(0, 1)
|
| 1695 |
|
| 1696 |
MettreFI = False ' lorsque l'on sort on met une face interne
|
| 1697 |
Me.Flag = 2
|
| 1698 |
Case 2
|
| 1699 |
MettreFI = False ' Attention, peut planter à cause de ça.
|
| 1700 |
End Select
|
| 1701 |
|
| 1702 |
|
| 1703 |
ElseIf Left(Nomsection, 1) = "T" Or Nomsection = " Poutre en T générique" Then ' le T
|
| 1704 |
Select Case numero
|
| 1705 |
Case 1
|
| 1706 |
Dim P(8, 1) As Double
|
| 1707 |
Dim d As Double
|
| 1708 |
d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
|
| 1709 |
|
| 1710 |
|
| 1711 |
P(0, 0) = 0
|
| 1712 |
P(0, 1) = 0
|
| 1713 |
P(1, 0) = -d
|
| 1714 |
P(1, 1) = -Poutre.GetD4 / 2.0R
|
| 1715 |
P(2, 0) = -(Poutre.GetD1 - Poutre.GetD5 - Poutre.GetD3)
|
| 1716 |
P(2, 1) = -Poutre.GetD4 / 2.0R
|
| 1717 |
P(3, 0) = P(2, 0)
|
| 1718 |
P(3, 1) = -Poutre.GetD2 / 2
|
| 1719 |
P(4, 0) = -Poutre.GetD1 + Poutre.GetD5
|
| 1720 |
P(4, 1) = P(3, 1)
|
| 1721 |
P(5, 0) = P(4, 0)
|
| 1722 |
P(5, 1) = -P(4, 1)
|
| 1723 |
P(6, 0) = P(3, 0)
|
| 1724 |
P(6, 1) = -P(3, 1)
|
| 1725 |
P(7, 0) = P(2, 0)
|
| 1726 |
P(7, 1) = -P(2, 1)
|
| 1727 |
P(8, 0) = P(1, 0)
|
| 1728 |
P(8, 1) = -P(1, 1)
|
| 1729 |
|
| 1730 |
r(0) = P(0, 0) + 1000 * Epsilon
|
| 1731 |
r(1) = 0 : r(2) = 0
|
| 1732 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1733 |
r(0) += TranslationX
|
| 1734 |
r(1) += TranslationY
|
| 1735 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1736 |
|
| 1737 |
pt3(0) -= TranslationX
|
| 1738 |
pt3(1) -= TranslationY
|
| 1739 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1740 |
For i = 0 To 8
|
| 1741 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1742 |
P(i, 0) += TranslationX
|
| 1743 |
P(i, 1) += TranslationY
|
| 1744 |
Next i
|
| 1745 |
|
| 1746 |
ReDim Ligne(35)
|
| 1747 |
For i = 0 To 7
|
| 1748 |
Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
|
| 1749 |
Next i
|
| 1750 |
Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
|
| 1751 |
|
| 1752 |
Case 2
|
| 1753 |
Dim P(4, 1) As Double
|
| 1754 |
Dim d As Double
|
| 1755 |
d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
|
| 1756 |
|
| 1757 |
P(0, 0) = 0
|
| 1758 |
P(0, 1) = 0
|
| 1759 |
|
| 1760 |
P(1, 0) = -d
|
| 1761 |
P(1, 1) = -Poutre.GetD4 / 2.0R
|
| 1762 |
P(2, 0) = Poutre.GetD5
|
| 1763 |
P(2, 1) = -Poutre.GetD4 / 2.0R
|
| 1764 |
P(3, 0) = P(2, 0)
|
| 1765 |
P(3, 1) = Poutre.GetD4 / 2
|
| 1766 |
P(4, 0) = P(1, 0)
|
| 1767 |
P(4, 1) = P(3, 1)
|
| 1768 |
|
| 1769 |
r(0) = P(0, 0) - 1000 * Epsilon
|
| 1770 |
r(1) = 0 : r(2) = 0
|
| 1771 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1772 |
r(0) += TranslationX
|
| 1773 |
r(1) += TranslationY
|
| 1774 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1775 |
|
| 1776 |
pt3(0) -= TranslationX
|
| 1777 |
pt3(1) -= TranslationY
|
| 1778 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1779 |
For i = 0 To 4
|
| 1780 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1781 |
P(i, 0) += TranslationX
|
| 1782 |
P(i, 1) += TranslationY
|
| 1783 |
Next i
|
| 1784 |
|
| 1785 |
ReDim Ligne(19)
|
| 1786 |
For i = 0 To 3
|
| 1787 |
Ligne(i * 4) = P(i, 0) : Ligne(i * 4 + 1) = P(i, 1) : Ligne(i * 4 + 2) = P(i + 1, 0) : Ligne(i * 4 + 3) = P(i + 1, 1)
|
| 1788 |
Next i
|
| 1789 |
Ligne(16) = P(4, 0) : Ligne(17) = P(4, 1) : Ligne(18) = P(0, 0) : Ligne(19) = P(0, 1)
|
| 1790 |
|
| 1791 |
End Select
|
| 1792 |
MettreFI = True
|
| 1793 |
|
| 1794 |
ElseIf Left(Poutre.GetNomSection, 1) = "P" Or Nomsection = " Circulaire pleine générique" Then ' Pipe,
|
| 1795 |
Dim P(2, 1) As Double
|
| 1796 |
Dim d As Double, e As Double
|
| 1797 |
d = Poutre.GetD1 / 4 ' Math.Sin(30) ( et on doit diviser le diamètre par 2)
|
| 1798 |
e = Poutre.GetD1 * Math.Sqrt(3) / 4 ' cos (30°)
|
| 1799 |
|
| 1800 |
P(0, 0) = 0
|
| 1801 |
P(0, 1) = 0
|
| 1802 |
P(1, 0) = d
|
| 1803 |
P(1, 1) = -e
|
| 1804 |
P(2, 0) = d
|
| 1805 |
P(2, 1) = e
|
| 1806 |
|
| 1807 |
Select Case numero
|
| 1808 |
Case 1
|
| 1809 |
r(0) = P(0, 0) + 1000 * Epsilon
|
| 1810 |
r(1) = 0 : r(2) = 0
|
| 1811 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1812 |
r(0) += TranslationX
|
| 1813 |
r(1) += TranslationY
|
| 1814 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1815 |
pt3(0) -= TranslationX
|
| 1816 |
pt3(1) -= TranslationY
|
| 1817 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1818 |
For i = 0 To 2
|
| 1819 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1820 |
P(i, 0) += TranslationX
|
| 1821 |
P(i, 1) += TranslationY
|
| 1822 |
Next i
|
| 1823 |
ReDim Ligne(7)
|
| 1824 |
Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
|
| 1825 |
Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
|
| 1826 |
swModel.CreateArc2(P(0, 0), P(0, 1), 0, P(1, 0), P(1, 1), 0, P(2, 0), P(2, 1), 0, 1) ' le dernier param est la direction. 1 ou -1
|
| 1827 |
|
| 1828 |
Case 2
|
| 1829 |
r(0) = P(0, 0) - 1000 * Epsilon
|
| 1830 |
r(1) = 0 : r(2) = 0
|
| 1831 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1832 |
r(0) += TranslationX
|
| 1833 |
r(1) += TranslationY
|
| 1834 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1835 |
|
| 1836 |
pt3(0) -= TranslationX
|
| 1837 |
pt3(1) -= TranslationY
|
| 1838 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1839 |
For i = 0 To 2
|
| 1840 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1841 |
P(i, 0) += TranslationX
|
| 1842 |
P(i, 1) += TranslationY
|
| 1843 |
Next i
|
| 1844 |
ReDim Ligne(7)
|
| 1845 |
Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
|
| 1846 |
Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
|
| 1847 |
|
| 1848 |
swModel.CreateArc2(P(0, 0), P(0, 1), 0, P(1, 0), P(1, 1), 0, P(2, 0), P(2, 1), 0, -1) ' le dernier param est la direction. 1 ou -1
|
| 1849 |
|
| 1850 |
End Select
|
| 1851 |
MettreFI = True
|
| 1852 |
|
| 1853 |
Else
|
| 1854 |
MsgBox("Section de poutre non reconnu!", MsgBoxStyle.Critical, "Commun.DessineSectionPoutre")
|
| 1855 |
End If
|
| 1856 |
|
| 1857 |
|
| 1858 |
If Not Ligne Is Nothing Then
|
| 1859 |
For i = 0 To UBound(Ligne) Step 4
|
| 1860 |
sketchline = swModel.CreateLine2(Ligne(i), Ligne(i + 1), 0, Ligne(i + 2), Ligne(i + 3), 0)
|
| 1861 |
Next i
|
| 1862 |
End If
|
| 1863 |
|
| 1864 |
Return r
|
| 1865 |
|
| 1866 |
End Function
|
| 1867 |
|
| 1868 |
Public Function SwFace() As SldWorks.Face2 ' retourne la première face de la liste (dans la partie traitement, ce sera la seule...)
|
| 1869 |
Return Me.lst_Faces.Item(0)
|
| 1870 |
End Function
|
| 1871 |
|
| 1872 |
Public Function IsFaceInterne(ByRef swface As SldWorks.Face2) As Boolean
|
| 1873 |
Dim attr As SldWorks.Attribute
|
| 1874 |
Dim SwEnt As SldWorks.Entity
|
| 1875 |
SwEnt = swface
|
| 1876 |
attr = SwEnt.FindAttribute(DefAttrFaceInterne, 0)
|
| 1877 |
If attr Is Nothing Then Return False Else Return True
|
| 1878 |
End Function
|
| 1879 |
|
| 1880 |
''' <summary>
|
| 1881 |
''' Fonction qui retourne un tableau de Sldworks.edge (et non slyedges)
|
| 1882 |
''' </summary>
|
| 1883 |
''' <returns>Un tableau de Edges</returns>
|
| 1884 |
''' <remarks></remarks>
|
| 1885 |
Public Function GetAretes() As SldWorks.Edge()
|
| 1886 |
Dim face As SldWorks.Face2
|
| 1887 |
Dim arete As SldWorks.Edge = Nothing
|
| 1888 |
Dim temp2 As Collections.Generic.List(Of SldWorks.Edge)
|
| 1889 |
Dim lst As New Collections.Generic.List(Of SldWorks.Edge)
|
| 1890 |
|
| 1891 |
For Each face In Me.lst_Faces
|
| 1892 |
temp2 = GetArete1Face(face)
|
| 1893 |
For Each arete In temp2
|
| 1894 |
lst.Add(arete)
|
| 1895 |
Next arete
|
| 1896 |
Next face
|
| 1897 |
|
| 1898 |
Return lst.ToArray
|
| 1899 |
End Function
|
| 1900 |
|
| 1901 |
Private Function GetArete1Face(ByRef Face As SldWorks.Face2) As Collections.Generic.List(Of SldWorks.Edge)
|
| 1902 |
Dim vArete As Object
|
| 1903 |
Dim a As SldWorks.Edge
|
| 1904 |
Dim arete() As SldWorks.Edge
|
| 1905 |
Dim lst As New Collections.Generic.List(Of SldWorks.Edge)
|
| 1906 |
|
| 1907 |
ReDim arete(Face.GetEdgeCount - 1)
|
| 1908 |
vArete = Face.GetEdges()
|
| 1909 |
|
| 1910 |
For Each a In vArete
|
| 1911 |
lst.Add(a)
|
| 1912 |
Next
|
| 1913 |
|
| 1914 |
Return lst
|
| 1915 |
End Function
|
| 1916 |
|
| 1917 |
Public Overrides Sub Selectionner(Optional ByVal Mark As Integer = 0, Optional ByRef append As Boolean = True)
|
| 1918 |
Dim swent As SldWorks.Entity
|
| 1919 |
Dim swface As SldWorks.Face2
|
| 1920 |
|
| 1921 |
For Each swface In lst_Faces
|
| 1922 |
swent = swface
|
| 1923 |
swent.Select2(append, Mark)
|
| 1924 |
Next swface
|
| 1925 |
End Sub
|
| 1926 |
|
| 1927 |
|
| 1928 |
''' <summary>
|
| 1929 |
''' Sélectionne toutes les faces dans la liste de faces
|
| 1930 |
''' </summary>
|
| 1931 |
''' <param name="Mark"></param>
|
| 1932 |
''' <param name="Append"></param>
|
| 1933 |
''' <remarks></remarks>
|
| 1934 |
Public Sub SelectionnerToutes(Optional ByRef Mark As Integer = 0, Optional ByRef Append As Boolean = True)
|
| 1935 |
Dim swFace As SldWorks.Face2
|
| 1936 |
|
| 1937 |
Dim swent As SldWorks.Entity
|
| 1938 |
If Append = False Then swModel.ClearSelection2(True)
|
| 1939 |
For Each swFace In Me.lst_Faces
|
| 1940 |
swent = swFace : swent.Select2(True, Mark)
|
| 1941 |
Next
|
| 1942 |
|
| 1943 |
End Sub
|
| 1944 |
|
| 1945 |
|
| 1946 |
|
| 1947 |
Public Function Couleur(ByRef rouge As Double, ByRef Vert As Double, ByRef Bleu As Double, Optional ByVal Ambient As Double = 1, Optional ByVal Diffuse As Double = 1, Optional ByVal Specular As Double = 1, Optional ByVal Shininess As Double = 0.5, Optional ByVal Transparency As Double = 0, Optional ByVal Emission As Double = 0.2) As Integer
|
| 1948 |
|
| 1949 |
swModel.SelectedFaceProperties(RGB(rouge, Vert, Bleu), Ambient, Diffuse, Specular, Shininess, Transparency, Emission, False, "")
|
| 1950 |
|
| 1951 |
Return 1
|
| 1952 |
End Function
|
| 1953 |
|
| 1954 |
Public Sub AjouterFace(ByRef face As SldWorks.Face2)
|
| 1955 |
Dim testface As SldWorks.Face2
|
| 1956 |
Dim faultentity As SldWorks.FaultEntity
|
| 1957 |
Dim swent As SldWorks.Entity
|
| 1958 |
|
| 1959 |
If Not Me.lst_Faces.Contains(face) Then Me.lst_Faces.Add(face)
|
| 1960 |
|
| 1961 |
' vérifier que les anciennes faces sont toujours ok...
|
| 1962 |
For Each testface In Me.lst_Faces
|
| 1963 |
faultentity = testface.Check
|
| 1964 |
If Not faultentity.Count = 0 Then ' on a un problème avec la face....
|
| 1965 |
lst_Faces.Remove(testface)
|
| 1966 |
Dim i As Integer
|
| 1967 |
For i = 0 To faultentity.Count
|
| 1968 |
swent = faultentity.Entity(i)
|
| 1969 |
If Not swent Is Nothing Then
|
| 1970 |
swent.Select4(True, Nothing)
|
| 1971 |
End If
|
| 1972 |
Debug.Print(" Fault[" & i & "] = " & swent.errorCode(i))
|
| 1973 |
Next i
|
| 1974 |
End If
|
| 1975 |
Next testface
|
| 1976 |
|
| 1977 |
|
| 1978 |
End Sub
|
| 1979 |
|
| 1980 |
|
| 1981 |
'Public Function DonnerFaces() As SldWorks.Face2()
|
| 1982 |
' 'Dim temp() As SldWorks.Face2
|
| 1983 |
' 'Dim i As Integer
|
| 1984 |
|
| 1985 |
' 'ReDim temp(lst_Faces.Count - 1)
|
| 1986 |
|
| 1987 |
' 'For i = 1 To lst_Faces.Count
|
| 1988 |
' ' temp(i - 1) = lst_Faces.Item(i)
|
| 1989 |
' 'Next
|
| 1990 |
|
| 1991 |
' Return lst_Faces.ToArray
|
| 1992 |
'End Function
|
| 1993 |
|
| 1994 |
|
| 1995 |
|
| 1996 |
''' <summary>
|
| 1997 |
''' Function qui retourne un pointeur vers la face
|
| 1998 |
''' </summary>
|
| 1999 |
''' <returns></returns>
|
| 2000 |
''' <remarks></remarks>
|
| 2001 |
Public Function GetFace() As SldWorks.Face2
|
| 2002 |
Return Me.SwFace
|
| 2003 |
End Function
|
| 2004 |
|
| 2005 |
''' <summary>
|
| 2006 |
''' Fonction qui redonne toutes les Faces contenues dans cette face
|
| 2007 |
''' </summary>
|
| 2008 |
''' <returns></returns>
|
| 2009 |
''' <remarks></remarks>
|
| 2010 |
Public Function GetFaces() As SldWorks.Face2()
|
| 2011 |
Return Me.lst_Faces.ToArray
|
| 2012 |
End Function
|
| 2013 |
|
| 2014 |
''' <summary>
|
| 2015 |
''' Sub qui renvoie les coordonnées min et max des valeurs U et V
|
| 2016 |
''' </summary>
|
| 2017 |
''' <param name="Umin"></param>
|
| 2018 |
''' <param name="UMax"></param>
|
| 2019 |
''' <param name="VMin"></param>
|
| 2020 |
''' <param name="VMax"></param>
|
| 2021 |
''' <remarks></remarks>
|
| 2022 |
Public Sub UVMinMax(ByRef Umin As Double, ByRef UMax As Double, ByRef VMin As Double, ByRef VMax As Double)
|
| 2023 |
Dim vBounds As Object
|
| 2024 |
vBounds = SwFace.GetUVBounds()
|
| 2025 |
|
| 2026 |
Umin = vBounds(0)
|
| 2027 |
UMax = vBounds(1)
|
| 2028 |
|
| 2029 |
VMin = vBounds(2)
|
| 2030 |
VMax = vBounds(3)
|
| 2031 |
End Sub
|
| 2032 |
|
| 2033 |
''' <summary>
|
| 2034 |
''' Calcule la position du point selon les U et V
|
| 2035 |
''' </summary>
|
| 2036 |
''' <param name="U"></param>
|
| 2037 |
''' <param name="V"></param>
|
| 2038 |
''' <param name="X"></param>
|
| 2039 |
''' <param name="Y"></param>
|
| 2040 |
''' <param name="Z"></param>
|
| 2041 |
''' <returns>Vrai si l epoint est sur la face, faux sinon</returns>
|
| 2042 |
''' <remarks>Retourne X, Y et Z même si le point n'est pas sur la face (mais sur la surface) </remarks>
|
| 2043 |
Public Function Evaluer(ByRef U As Double, ByVal V As Double, ByRef X As Double, ByRef Y As Double, ByRef Z As Double) As Boolean
|
| 2044 |
Dim surf As SldWorks.Surface
|
| 2045 |
Dim vEv As Object, vpoint As Object
|
| 2046 |
Dim P(2) As Double
|
| 2047 |
|
| 2048 |
surf = SwFace.GetSurface()
|
| 2049 |
|
| 2050 |
vEv = surf.Evaluate(U, V, 0, 0)
|
| 2051 |
|
| 2052 |
X = vEv(0) : Y = vEv(1) : Z = vEv(2)
|
| 2053 |
|
| 2054 |
vpoint = SwFace.GetClosestPointOn(X, Y, Z)
|
| 2055 |
|
| 2056 |
If (Math.Abs(vpoint(0) - X) < Epsilon) And (Math.Abs(vpoint(1) - Y) < Epsilon) And (Math.Abs(vpoint(2) - Z) < Epsilon) Then Return True Else Return False
|
| 2057 |
|
| 2058 |
End Function
|
| 2059 |
|
| 2060 |
''' <summary>
|
| 2061 |
''' Function qui calcule la normale d'une face au point X,Y,Z.
|
| 2062 |
''' </summary>
|
| 2063 |
''' <param name="X"></param>
|
| 2064 |
''' <param name="Y"></param>
|
| 2065 |
''' <param name="Z"></param>
|
| 2066 |
''' <returns>Un tableau de 3 doubles correspondant à la normale</returns>
|
| 2067 |
''' <remarks></remarks>
|
| 2068 |
Public Function Normale(ByRef X As Double, ByRef Y As Double, ByRef Z As Double) As Double()
|
| 2069 |
Dim surf As SldWorks.Surface
|
| 2070 |
Dim vtemp As Object
|
| 2071 |
Dim temp() As Double
|
| 2072 |
Dim sens As Boolean
|
| 2073 |
|
| 2074 |
surf = SwFace.GetSurface
|
| 2075 |
If surf.IsPlane Then vtemp = SwFace.Normal : temp = vtemp : Return temp ' si la face est plane alors c'est ok, sinon il faut travailler...
|
| 2076 |
|
| 2077 |
|
| 2078 |
vtemp = surf.EvaluateAtPoint(X, Y, Z)
|
| 2079 |
ReDim temp(2)
|
| 2080 |
|
| 2081 |
' la normale de la face pointe AWAY from the body
|
| 2082 |
|
| 2083 |
sens = SwFace.FaceInSurfaceSense() 'TRUE if face normal and surface normal are in the opposite direction and FALSE if they are in the same direction
|
| 2084 |
|
| 2085 |
|
| 2086 |
If sens Then ' on doit inverser
|
| 2087 |
temp(0) = -vtemp(0) : temp(1) = -vtemp(1) : temp(2) = -vtemp(2)
|
| 2088 |
Else
|
| 2089 |
temp(0) = vtemp(0) : temp(1) = vtemp(1) : temp(2) = vtemp(2)
|
| 2090 |
End If
|
| 2091 |
Return temp
|
| 2092 |
|
| 2093 |
End Function
|
| 2094 |
|
| 2095 |
|
| 2096 |
Public Sub MettreAttributFaceInterne(Optional ByRef Valeur As Double = 0)
|
| 2097 |
Dim no As Integer = 0
|
| 2098 |
Dim nom As String = "FaceInterne" & no
|
| 2099 |
Dim swent As SldWorks.Entity
|
| 2100 |
Dim attr As SldWorks.Attribute
|
| 2101 |
|
| 2102 |
swent = Me.SwFace
|
| 2103 |
attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
|
| 2104 |
If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, SwFace, nom, 0, 2) ' 0 = swThisconfig
|
| 2105 |
While attr Is Nothing
|
| 2106 |
no += 1
|
| 2107 |
nom = "FaceInterne" & CStr(no)
|
| 2108 |
attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, SwFace, nom, 0, 2)
|
| 2109 |
End While
|
| 2110 |
GererDossiers("FaceInternes", nom)
|
| 2111 |
|
| 2112 |
End Sub
|
| 2113 |
|
| 2114 |
|
| 2115 |
End Class
|
