| 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 quand la face interne ne touche pas à la poutre
|
| 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 cercle (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 |
swSketch = swModel.GetActiveSketch2()
|
| 118 |
If swSketch Is Nothing Then swModel.Insert3DSketch2(True) : swSketch = swModel.GetActiveSketch2()
|
| 119 |
If swSketch Is Nothing Then MsgBox("Ça merde vraiment...")
|
| 120 |
swModel.CreateLine2(x1, y1, z1, x2, y2, z2)
|
| 121 |
swModel.Insert3DSketch2(True)
|
| 122 |
swEnt = swSketch : swEnt.Select2(False, 1)
|
| 123 |
swModel.InsertCompositeCurve()
|
| 124 |
|
| 125 |
' reste à lui mettre les propriétés de mini-poutres
|
| 126 |
feat = swModel.FeatureByPositionReverse(0)
|
| 127 |
refCourbe = feat.GetSpecificFeature2
|
| 128 |
swArete = refCourbe.GetFirstSegment ' y'a juste un segment
|
| 129 |
|
| 130 |
swEnt = swArete
|
| 131 |
Dim NomAttr As String
|
| 132 |
NomAttr = "miniPoutre" & Me.nom & k
|
| 133 |
|
| 134 |
attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, swArete, NomAttr, 0, 0)
|
| 135 |
' mettre les propriétés de la mini-poutre
|
| 136 |
' attention, elle ne doit pas avoir de masse, sa section est alors Mini...
|
| 137 |
|
| 138 |
p = attr.GetParameter("As")
|
| 139 |
p.SetDoubleValue2(-7, 2, "")
|
| 140 |
Commun.GererDossiers("Poutres", NomAttr)
|
| 141 |
k += 1
|
| 142 |
|
| 143 |
|
| 144 |
End Sub
|
| 145 |
|
| 146 |
|
| 147 |
Friend Overridable Function AjouterInterFace(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterCoqueVolume
|
| 148 |
' sub qui CRÉÉ une instance de la classe InterFaceFace si et seulement si il n'en existe pas avant
|
| 149 |
|
| 150 |
|
| 151 |
'Dim int As InterFaceFace
|
| 152 |
|
| 153 |
' créez la routine qui ignore la création de
|
| 154 |
Return Nothing ' pout l'instant
|
| 155 |
End Function
|
| 156 |
|
| 157 |
|
| 158 |
|
| 159 |
Shared Sub reinitialiser()
|
| 160 |
compteur = 0
|
| 161 |
End Sub
|
| 162 |
|
| 163 |
Public Overrides Sub SaveNom()
|
| 164 |
' procédure qui enregistre le nom et qui , pour l'instant ne tient pas compte des conditions aux limites
|
| 165 |
Dim ent As SldWorks.Entity
|
| 166 |
Dim i As Long
|
| 167 |
Dim nomtemp As String
|
| 168 |
'For i = 1 To Me.lst_Faces.Count
|
| 169 |
For Each swFace As SldWorks.Face2 In Me.lst_Faces
|
| 170 |
ent = swFace
|
| 171 |
Dim retval As Boolean
|
| 172 |
If Me.lst_Faces.Count > 1 Then nomtemp = nom & "-" & Chr(i + 96) Else nomtemp = nom
|
| 173 |
retval = swPart.SetEntityName(ent, nomtemp)
|
| 174 |
If retval = False Then
|
| 175 |
Dim nom2 As String
|
| 176 |
'Dim swface As SldWorks.Face2
|
| 177 |
'swface = ent
|
| 178 |
'If Me.SwFace Is swface Then MsgBox("La même face!")
|
| 179 |
nom2 = swPart.GetEntityName(ent)
|
| 180 |
'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")
|
| 181 |
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")
|
| 182 |
End If
|
| 183 |
Next
|
| 184 |
|
| 185 |
|
| 186 |
|
| 187 |
End Sub
|
| 188 |
|
| 189 |
|
| 190 |
Public Function GetNormale(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double()
|
| 191 |
Dim surf As SldWorks.Surface
|
| 192 |
Dim retval As Object
|
| 193 |
Dim temp(2) As Double
|
| 194 |
|
| 195 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 196 |
retval = surf.EvaluateAtPoint(x, y, z)
|
| 197 |
|
| 198 |
If retval Is Nothing Then MsgBox("Erreur, dans le Getnormal de la face, le point ne semble pas être sur la face")
|
| 199 |
|
| 200 |
temp(0) = retval(0)
|
| 201 |
temp(1) = retval(1)
|
| 202 |
temp(2) = retval(2)
|
| 203 |
|
| 204 |
Return temp
|
| 205 |
End Function
|
| 206 |
Public Function GetNormaleSurface(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double()
|
| 207 |
Dim surf As SldWorks.Surface
|
| 208 |
Dim retval As Object = Nothing
|
| 209 |
Dim temp(2) As Double
|
| 210 |
|
| 211 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 212 |
retval = surf.EvaluateAtPoint(x, y, z)
|
| 213 |
|
| 214 |
temp(0) = retval(0)
|
| 215 |
temp(1) = retval(1)
|
| 216 |
temp(2) = retval(2)
|
| 217 |
|
| 218 |
Return temp
|
| 219 |
End Function
|
| 220 |
|
| 221 |
|
| 222 |
|
| 223 |
Public Function GetRayonCourbureMax(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
|
| 224 |
Dim surf As SldWorks.Surface
|
| 225 |
Dim retval As Object
|
| 226 |
Dim temp As Double
|
| 227 |
|
| 228 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 229 |
retval = surf.EvaluateAtPoint(x, y, z)
|
| 230 |
|
| 231 |
temp = retval(9)
|
| 232 |
|
| 233 |
Return temp
|
| 234 |
End Function
|
| 235 |
|
| 236 |
Public Function GetRayonCourbureMin(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
|
| 237 |
Dim surf As SldWorks.Surface
|
| 238 |
Dim retval As Object
|
| 239 |
Dim temp As Double
|
| 240 |
|
| 241 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 242 |
retval = surf.EvaluateAtPoint(x, y, z)
|
| 243 |
|
| 244 |
temp = retval(10)
|
| 245 |
|
| 246 |
Return temp
|
| 247 |
End Function
|
| 248 |
|
| 249 |
' si la surface est un cylindre, retourne son rayon. Plante ou valeur aléatoire si pas un cylindre
|
| 250 |
Public Function GetRayonCylindre() As Double
|
| 251 |
Dim surf As SldWorks.Surface
|
| 252 |
Dim retval As Object
|
| 253 |
Dim temp As Double
|
| 254 |
|
| 255 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 256 |
retval = surf.CylinderParams
|
| 257 |
|
| 258 |
temp = retval(6)
|
| 259 |
|
| 260 |
Return temp
|
| 261 |
End Function
|
| 262 |
|
| 263 |
|
| 264 |
''' <summary>
|
| 265 |
''' Retourne vrai si une face est plane
|
| 266 |
''' </summary>
|
| 267 |
''' <returns></returns>
|
| 268 |
''' <remarks></remarks>
|
| 269 |
Public Function estPlan() As Boolean
|
| 270 |
Dim surf As SldWorks.Surface
|
| 271 |
|
| 272 |
surf = Me.lst_Faces.Item(0).GetSurface()
|
| 273 |
|
| 274 |
If surf.IsPlane Then Return True Else Return False
|
| 275 |
|
| 276 |
End Function
|
| 277 |
|
| 278 |
|
| 279 |
''' <summary>
|
| 280 |
''' Retourne vrai si la face est un plan mais pas vu comme tel par solidworks.
|
| 281 |
''' </summary>
|
| 282 |
''' <param name="x"></param>
|
| 283 |
''' <param name="y"></param>
|
| 284 |
''' <param name="z"></param>
|
| 285 |
''' <returns></returns>
|
| 286 |
''' <remarks></remarks>
|
| 287 |
Public Function estFauxPlan(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean
|
| 288 |
Dim surf As SldWorks.Surface
|
| 289 |
surf = Me.lst_Faces.Item(0).GetSurface()
|
| 290 |
If Not surf.IsParametric Then Return False
|
| 291 |
|
| 292 |
' si la normale est la même au point d'intersection et à quelques sommets, alors on a une face plane.
|
| 293 |
Dim Normale(2) As Double
|
| 294 |
Dim vNormale As Object
|
| 295 |
|
| 296 |
vNormale = surf.EvaluateAtPoint(x, y, z) ' la normale du point d'intersection
|
| 297 |
Normale(0) = vNormale(0)
|
| 298 |
Normale(1) = vNormale(1)
|
| 299 |
Normale(2) = vNormale(2)
|
| 300 |
|
| 301 |
Dim i As Integer
|
| 302 |
Dim U As Double, V As Double, Umin As Double, Umax As Double, Vmin As Double, Vmax As Double
|
| 303 |
Dim retval As Object
|
| 304 |
|
| 305 |
retval = surf.Parameterization()
|
| 306 |
Umin = retval(0)
|
| 307 |
Umax = retval(1)
|
| 308 |
Vmin = retval(2)
|
| 309 |
Vmax = retval(3)
|
| 310 |
|
| 311 |
Randomize()
|
| 312 |
|
| 313 |
For i = 0 To 5
|
| 314 |
U = Rnd() * (Umax - Umin) + Umin
|
| 315 |
V = Rnd() * (Vmax - Vmin) + Vmin
|
| 316 |
vNormale = surf.Evaluate(U, V, 0, 0)
|
| 317 |
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
|
| 318 |
Next i
|
| 319 |
|
| 320 |
Return True
|
| 321 |
|
| 322 |
|
| 323 |
|
| 324 |
End Function
|
| 325 |
|
| 326 |
Public Function estCylindre() As Boolean
|
| 327 |
Dim surf As SldWorks.Surface
|
| 328 |
|
| 329 |
surf = Me.lst_Faces.Item(0).GetSurface
|
| 330 |
|
| 331 |
If surf.IsCylinder Then Return True Else Return False
|
| 332 |
|
| 333 |
End Function
|
| 334 |
|
| 335 |
|
| 336 |
Protected Overrides Sub Finalize()
|
| 337 |
' mettre l'effacement des listes ici.
|
| 338 |
|
| 339 |
MyBase.Finalize()
|
| 340 |
End Sub
|
| 341 |
|
| 342 |
|
| 343 |
|
| 344 |
Public Sub MettreAttributPourConditionLimite()
|
| 345 |
Dim swent As SldWorks.Entity
|
| 346 |
Dim nom As String
|
| 347 |
Dim cond As String
|
| 348 |
|
| 349 |
cond = Me.condition
|
| 350 |
If cond = "" Then Exit Sub
|
| 351 |
|
| 352 |
swent = Me.SwFace
|
| 353 |
|
| 354 |
nom = Me.nom & "CL" & CStr(no) & "_" & cond
|
| 355 |
Dim Attr As SldWorks.Attribute = Nothing
|
| 356 |
|
| 357 |
Try
|
| 358 |
Attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
|
| 359 |
Catch ex As Exception
|
| 360 |
MsgBox("N'arrive pas à se lier à l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
|
| 361 |
End Try
|
| 362 |
|
| 363 |
If Attr Is Nothing Then Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.SwFace, nom, 0, 2) ' 0 = swThisconfig
|
| 364 |
|
| 365 |
|
| 366 |
While Attr Is Nothing
|
| 367 |
no += 1
|
| 368 |
nom = "CL" & Me.nom & "_" & cond
|
| 369 |
Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.SwFace, nom, 0, 0)
|
| 370 |
End While
|
| 371 |
|
| 372 |
|
| 373 |
Dim ParamCL As SldWorks.Parameter
|
| 374 |
ParamCL = Attr.GetParameter("CL")
|
| 375 |
|
| 376 |
ParamCL.SetStringValue2(cond, 2, "") ' swAllConfiguration = 2
|
| 377 |
Me.AttributCL = Attr
|
| 378 |
GererDossiers("Conditions Aux Limites", nom)
|
| 379 |
no = no + 1
|
| 380 |
|
| 381 |
End Sub
|
| 382 |
|
| 383 |
' une fonction qui transforme un attribut en condition aux limites
|
| 384 |
Public Sub AttributVersConditionLimite()
|
| 385 |
Dim p As SldWorks.Parameter
|
| 386 |
Dim ent As SldWorks.Entity
|
| 387 |
Dim attr As SldWorks.Attribute
|
| 388 |
|
| 389 |
ent = Me.SwFace
|
| 390 |
attr = ent.FindAttribute(Intersections.DefAttrConditionLimite, 0)
|
| 391 |
If Not attr Is Nothing Then
|
| 392 |
p = attr.GetParameter("CL")
|
| 393 |
nom = nomOrig & "@" & p.GetStringValue
|
| 394 |
End If
|
| 395 |
|
| 396 |
End Sub
|
| 397 |
|
| 398 |
|
| 399 |
|
| 400 |
|
| 401 |
|
| 402 |
' sub qui coupe la face avec une arète qui repose dessus.
|
| 403 |
Friend Sub CoupeLong(ByRef inter As InterPoutreVolume, ByVal poutre As SlyAretePoutre)
|
| 404 |
|
| 405 |
|
| 406 |
'Dim swEnt As SldWorks.Entity
|
| 407 |
'Dim swSketchSegment As SldWorks.SketchSegment
|
| 408 |
'Dim vSketchSegments As Object
|
| 409 |
'Dim swSketch As SldWorks.Sketch
|
| 410 |
'Dim faceinterne(1) As SldWorks.Face2
|
| 411 |
'Dim swPlan As SldWorks.RefPlane = Nothing
|
| 412 |
'Dim b As Integer
|
| 413 |
'Dim swSommet As SldWorks.Vertex
|
| 414 |
'Dim i As Integer
|
| 415 |
|
| 416 |
'swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
|
| 417 |
|
| 418 |
'' faut découper toutes les faces de la liste si elles ne sont pas des faces internes
|
| 419 |
'Dim MeFace As SldWorks.Face2
|
| 420 |
''Dim ListeFace() As SldWorks.Face2
|
| 421 |
''ReDim ListeFace(Me.lst_Faces.Count - 1)
|
| 422 |
|
| 423 |
''For i = 1 To Me.lst_Faces.Count
|
| 424 |
''ListeFace(i - 1) = Me.lst_Faces.Item(i)
|
| 425 |
''Next
|
| 426 |
|
| 427 |
'For Each MeFace In Me.lst_Faces 'ListeFace
|
| 428 |
|
| 429 |
' If Me.estPlan Then
|
| 430 |
' swEnt = MeFace
|
| 431 |
' swEnt.Select(False)
|
| 432 |
' swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
|
| 433 |
' swEnt.Select(False)
|
| 434 |
' swModel.InsertSketch2(True)
|
| 435 |
|
| 436 |
' swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
|
| 437 |
|
| 438 |
' ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
|
| 439 |
' If b = 0 Then
|
| 440 |
' Dim vEdge As Object
|
| 441 |
|
| 442 |
|
| 443 |
' vEdge = MeFace.GetEdges
|
| 444 |
' swModel.ClearSelection2(True)
|
| 445 |
' While swPlan Is Nothing
|
| 446 |
' 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
|
| 447 |
' swSommet = vEdge(i).GetStartVertex()
|
| 448 |
' swEnt = swSommet
|
| 449 |
' swEnt.Select4(False, Nothing)
|
| 450 |
' swSommet = vEdge(i + 1).GetStartVertex()
|
| 451 |
' swEnt = swSommet
|
| 452 |
' swEnt.Select4(True, Nothing)
|
| 453 |
' swSommet = vEdge(i + 2).GetStartVertex()
|
| 454 |
' swEnt = swSommet
|
| 455 |
' swEnt.Select4(True, Nothing)
|
| 456 |
' i += 1
|
| 457 |
' swPlan = swModel.CreatePlaneThru3Points3(False)
|
| 458 |
|
| 459 |
' End While
|
| 460 |
' End If
|
| 461 |
' swEnt = swPlan
|
| 462 |
' swEnt.Select(False)
|
| 463 |
' swModel.InsertSketch2(True)
|
| 464 |
|
| 465 |
' Else
|
| 466 |
' MsgBox("Dans coupeLong, on a un type de face qui n'est pas encore traité")
|
| 467 |
|
| 468 |
' End If
|
| 469 |
|
| 470 |
|
| 471 |
' swSketch = swModel.GetActiveSketch2
|
| 472 |
|
| 473 |
' swEnt = poutre.swArete
|
| 474 |
' swEnt.Select(False)
|
| 475 |
|
| 476 |
' ' créer la ligne de «conversion de entités»
|
| 477 |
' swModel.SketchUseEdge2(False)
|
| 478 |
|
| 479 |
' vSketchSegments = swSketch.GetSketchSegments()
|
| 480 |
' swSketchSegment = vSketchSegments(0)
|
| 481 |
' swSketchSegment.Select2(False, 1) 'on sélectionne l'arète de poutre...
|
| 482 |
|
| 483 |
' Dim x As Double, y As Double, z As Double
|
| 484 |
' Commun.GetMidPointSegment(swSketchSegment, x, y, z)
|
| 485 |
|
| 486 |
|
| 487 |
' ' sketchoffset doit avoir un mark de 1 pour l'objet à offsetter. Une valeur négative inverse la direction
|
| 488 |
' swModel.SketchManager.SketchOffset(poutre.GetD2, False, 0, 0, 0, 0)
|
| 489 |
' ' pour rendre le modèle plus beau, on peut enlever la contrainte de offset et laisser solidworks mettre des contraintes automatiques...
|
| 490 |
|
| 491 |
' Dim retval As Object
|
| 492 |
' Dim skPointA1 As sldworks.SketchPoint = Nothing, skPointA2 As sldworks.SketchPoint = Nothing, skPointB1 As sldworks.SketchPoint = Nothing, skPointB2 As sldworks.SketchPoint = Nothing
|
| 493 |
|
| 494 |
' vSketchSegments = swSketch.GetSketchSegments()
|
| 495 |
' swSketchSegment = vSketchSegments(1)
|
| 496 |
|
| 497 |
|
| 498 |
' Select Case swSketchSegment.GetType()
|
| 499 |
' Case 0 ' on a une ligne
|
| 500 |
' Dim sketchline As sldworks.SketchLine
|
| 501 |
' sketchline = swSketchSegment
|
| 502 |
' skPointA1 = sketchline.GetStartPoint2
|
| 503 |
' skPointA2 = sketchline.GetEndPoint2()
|
| 504 |
' Case 1 ' arc
|
| 505 |
' Dim arc As sldworks.SketchArc
|
| 506 |
' arc = swSketchSegment
|
| 507 |
' skPointA1 = arc.GetStartPoint
|
| 508 |
' skPointA2 = arc.GetEndPoint2
|
| 509 |
' Case 2 ' ellipse
|
| 510 |
' Dim sketchEllipse As sldworks.SketchEllipse
|
| 511 |
' sketchEllipse = swSketchSegment
|
| 512 |
' skPointA1 = sketchEllipse.GetStartPoint2
|
| 513 |
' skPointA2 = sketchEllipse.GetEndPoint2
|
| 514 |
' Case 3 ' spline
|
| 515 |
' Dim spline As sldworks.SketchSpline
|
| 516 |
' Dim pts() As sldworks.SketchPoint
|
| 517 |
' spline = swSketchSegment
|
| 518 |
' retval = spline.GetPoints2()
|
| 519 |
' pts = retval
|
| 520 |
' skPointA1 = pts(0)
|
| 521 |
' skPointA2 = pts(UBound(pts))
|
| 522 |
' Case 5 ' parabole (le 4 est du texte)
|
| 523 |
' Dim para As sldworks.SketchParabola
|
| 524 |
' para = swSketchSegment
|
| 525 |
' skPointA1 = para.GetStartPoint2
|
| 526 |
' skPointA2 = para.GetEndPoint2
|
| 527 |
' End Select
|
| 528 |
|
| 529 |
' swSketchSegment = vSketchSegments(0)
|
| 530 |
' Select Case swSketchSegment.GetType()
|
| 531 |
' Case 0 ' on a une ligne
|
| 532 |
' Dim sketchline As sldworks.SketchLine
|
| 533 |
' sketchline = swSketchSegment
|
| 534 |
' skPointB1 = sketchline.GetStartPoint2
|
| 535 |
' skPointB2 = sketchline.GetEndPoint2()
|
| 536 |
' Case 1 ' arc
|
| 537 |
' Dim arc As sldworks.SketchArc
|
| 538 |
' arc = swSketchSegment
|
| 539 |
' skPointB1 = arc.GetStartPoint
|
| 540 |
' skPointB2 = arc.GetEndPoint2
|
| 541 |
' Case 2 ' ellipse
|
| 542 |
' Dim sketchEllipse As sldworks.SketchEllipse
|
| 543 |
' sketchEllipse = swSketchSegment
|
| 544 |
' skPointB1 = sketchEllipse.GetStartPoint2
|
| 545 |
' skPointB2 = sketchEllipse.GetEndPoint2
|
| 546 |
' Case 3 ' spline
|
| 547 |
' Dim spline As sldworks.SketchSpline
|
| 548 |
' Dim pts() As sldworks.SketchPoint
|
| 549 |
' spline = swSketchSegment
|
| 550 |
' retval = spline.GetPoints2()
|
| 551 |
' pts = retval
|
| 552 |
' skPointB1 = pts(0)
|
| 553 |
' skPointB2 = pts(UBound(pts))
|
| 554 |
' Case 5 ' parabole (le 4 est du texte)
|
| 555 |
' Dim para As sldworks.SketchParabola
|
| 556 |
' para = swSketchSegment
|
| 557 |
' skPointB1 = para.GetStartPoint2
|
| 558 |
' skPointB2 = para.GetEndPoint2
|
| 559 |
' End Select
|
| 560 |
|
| 561 |
' ' création des 2 lignes pour fermer le sketch.
|
| 562 |
' swModel.CreateLine2(skPointA1.X, skPointA1.Y, 0, skPointB1.X, skPointB1.Y, 0)
|
| 563 |
' swModel.CreateLine2(skPointA2.X, skPointA2.Y, 0, skPointB2.X, skPointB2.Y, 0)
|
| 564 |
|
| 565 |
|
| 566 |
' Dim x2 As Double, y2 As Double, z2 As Double ' le midpoint de la poutre
|
| 567 |
' Dim x3 As Double, y3 As Double, z3 As Double ' le midpoint de la poutre
|
| 568 |
|
| 569 |
' swSketchSegment = vSketchSegments(0) ' le midpoint d'une poutre
|
| 570 |
' Commun.GetMidPointSegment(swSketchSegment, x2, y2, z2)
|
| 571 |
|
| 572 |
' swSketchSegment = vSketchSegments(1) ' le midpoint de l'autre poutre
|
| 573 |
' Commun.GetMidPointSegment(swSketchSegment, x3, y3, z3)
|
| 574 |
|
| 575 |
' Dim sk(1) As Double, r(2) As Double
|
| 576 |
' sk(0) = (x3 + x2) / 2
|
| 577 |
' sk(1) = (y3 + y2) / 2
|
| 578 |
' r = Commun.TransfertSketchToModel(swSketch, sk)
|
| 579 |
|
| 580 |
' swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
|
| 581 |
' swModel.ClearSelection2(True)
|
| 582 |
' swEnt = MeFace : swEnt.Select2(False, 1)
|
| 583 |
' swEnt = swSketch : swEnt.Select2(True, 4)
|
| 584 |
|
| 585 |
' swModel.InsertSplitLineProject(False, False)
|
| 586 |
|
| 587 |
' Me.Flag = 20 ' pour dire que l'on a un coupeLong
|
| 588 |
' 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
|
| 589 |
' Me.Flag = 0
|
| 590 |
|
| 591 |
|
| 592 |
End Sub
|
| 593 |
|
| 594 |
|
| 595 |
|
| 596 |
''' <summary>
|
| 597 |
''' Sub qui appelle le découpage de la face
|
| 598 |
''' </summary>
|
| 599 |
''' <remarks>On devrait revoir cette sub en fonction des nouveaux outils de VB2005</remarks>
|
| 600 |
Public Overridable Sub decouper()
|
| 601 |
MsgBox("La fonction non Overridé a été appelée!")
|
| 602 |
End Sub
|
| 603 |
|
| 604 |
|
| 605 |
''' <summary>
|
| 606 |
''' Renvoie le nombre d'arêtes dans la face principale
|
| 607 |
''' </summary>
|
| 608 |
''' <value></value>
|
| 609 |
''' <returns></returns>
|
| 610 |
''' <remarks></remarks>
|
| 611 |
Public ReadOnly Property NbSommets() As Integer
|
| 612 |
Get
|
| 613 |
Dim lst_sommets As New Collections.Generic.List(Of sldworks.Vertex)
|
| 614 |
Dim swSommet As sldworks.Vertex = Nothing
|
| 615 |
Dim vedges As Object = Me.SwFace.GetEdges
|
| 616 |
For Each edge As sldworks.Edge In vedges
|
| 617 |
swSommet = edge.GetStartVertex
|
| 618 |
If swSommet IsNot Nothing Then
|
| 619 |
lst_sommets.Add(swSommet)
|
| 620 |
swSommet = edge.GetEndVertex
|
| 621 |
lst_sommets.Add(swSommet)
|
| 622 |
End If
|
| 623 |
Next
|
| 624 |
Return lst_sommets.Count
|
| 625 |
End Get
|
| 626 |
End Property
|
| 627 |
|
| 628 |
''' <summary>
|
| 629 |
''' Coupe si nécesaire la face lorsque l'on a une poutre avec face de section. À noter que si l'on coupe c'est avec un angle de pi / 8
|
| 630 |
''' </summary>
|
| 631 |
''' <param name="inter"></param>
|
| 632 |
''' <remarks></remarks>
|
| 633 |
Protected Sub CoupeFaceDeSection(ByRef inter As InterPoutreVolume)
|
| 634 |
Dim swEnt As sldworks.Entity = Nothing
|
| 635 |
Dim Directionnel As Boolean
|
| 636 |
Dim Faces(3) As sldworks.Face2
|
| 637 |
Dim r(2) As Double
|
| 638 |
Dim p(2) As Double
|
| 639 |
Dim planReference As sldworks.RefPlane = Nothing
|
| 640 |
Dim swsketch As sldworks.Sketch
|
| 641 |
Dim pointdeb(2) As Double, pointfin(2) As Double
|
| 642 |
Dim sketchline As sldworks.SketchLine
|
| 643 |
Dim swFeat As sldworks.Feature
|
| 644 |
|
| 645 |
|
| 646 |
swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
|
| 647 |
|
| 648 |
swEnt = Me.SwFace
|
| 649 |
swEnt.Select(False)
|
| 650 |
swModel.InsertSketch2(False)
|
| 651 |
swsketch = swModel.GetActiveSketch2
|
| 652 |
|
| 653 |
' dessin de la forme à faire SI NÉCESSAIRE
|
| 654 |
If Me.NbSommets = 0 OrElse Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
|
| 655 |
|
| 656 |
Dim xyzc() As Double, xyz(2) As Double
|
| 657 |
xyz(0) = inter.x : xyz(1) = inter.y : xyz(2) = inter.z
|
| 658 |
xyzc = Commun.TransfertModelSketch(swsketch, xyz)
|
| 659 |
|
| 660 |
sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) + Math.Cos(Pi / 8), xyzc(1) + Math.Sin(Pi / 8), 0)
|
| 661 |
sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) - Math.Cos(Pi / 8), xyzc(1) + Math.Sin(Pi / 8), 0)
|
| 662 |
swModel.CreateArc2(xyzc(0), xyzc(1), 0, xyzc(0) + Math.Cos(Pi / 8), xyzc(1) + Math.Sin(Pi / 8), 0, xyzc(0) - Math.Cos(Pi / 8), xyzc(1) + Math.Sin(Pi / 8), 0, 1) ' le dernier param est la direction. 1 ou -1
|
| 663 |
|
| 664 |
swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
|
| 665 |
swModel.ClearSelection2(True)
|
| 666 |
|
| 667 |
swEnt = Me.SwFace : swEnt.Select2(False, 1)
|
| 668 |
swEnt = swsketch : swEnt.Select2(True, 4)
|
| 669 |
swModel.InsertSplitLineProject(Directionnel, False)
|
| 670 |
|
| 671 |
|
| 672 |
' flagger les 2 faces comme faces Internes.
|
| 673 |
Dim vface As Object
|
| 674 |
Dim face As sldworks.Face2 = Nothing
|
| 675 |
swFeat = swModel.FeatureByPositionReverse(0)
|
| 676 |
Try
|
| 677 |
vface = swFeat.GetFaces
|
| 678 |
For Each face In vface
|
| 679 |
no = Me.MettreAttributFaceInterne(face, 2 * Me.Aire / Me.Perimetre, True) ' plus certain que l'on a besoin du numéro
|
| 680 |
Me.AjouterFace(face)
|
| 681 |
Next face
|
| 682 |
Catch
|
| 683 |
' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
|
| 684 |
' on doit donc le déterminer anyway
|
| 685 |
End Try
|
| 686 |
|
| 687 |
' si ça ne touche pas à la face
|
| 688 |
If Not Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
|
| 689 |
AjouterMiniPoutresSurFaceInterne(inter.lst_sPoutre.Item(1), face, inter.x, inter.y, inter.z)
|
| 690 |
'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") & " )")
|
| 691 |
End If
|
| 692 |
|
| 693 |
Else ' flagger la seule face comme face interne
|
| 694 |
Me.MettreAttributFaceInterne(Me.SwFace, 2 * Me.Aire / Me.Perimetre, True)
|
| 695 |
If Not Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
|
| 696 |
AjouterMiniPoutresSurFaceInterne(inter.lst_sPoutre.Item(1), Me.SwFace, inter.x, inter.y, inter.z)
|
| 697 |
'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") & " )")
|
| 698 |
End If
|
| 699 |
End If
|
| 700 |
swModel.SetInferenceMode(True)
|
| 701 |
|
| 702 |
End Sub
|
| 703 |
|
| 704 |
|
| 705 |
Friend Overridable Sub chercherAttributs()
|
| 706 |
Dim swEnt As sldworks.Entity
|
| 707 |
Dim attr As sldworks.Attribute
|
| 708 |
|
| 709 |
swEnt = Me.SwFace
|
| 710 |
|
| 711 |
attr = swEnt.FindAttribute(Intersections.DefAttrConditionLimite, 0)
|
| 712 |
If Not attr Is Nothing Then Me.AttributCL = attr : attr = Nothing
|
| 713 |
|
| 714 |
'attr = swent.findattribute(intersections.DefAttrFaceInterne,0) ' ne devrait pas s'entrecouper...
|
| 715 |
|
| 716 |
End Sub
|
| 717 |
|
| 718 |
Protected Function Flipper(ByRef PlanDessus As sldworks.RefPlane, ByRef inter As InterAreteFace) As Boolean
|
| 719 |
' function qui dit si l'on doit flipper le sens du plan de référence.
|
| 720 |
' calcul de la direction à prendre
|
| 721 |
Dim retval As Object
|
| 722 |
Dim ret(8) As Double
|
| 723 |
Dim ret2(6) As Double
|
| 724 |
Dim normalePlan(2) As Double
|
| 725 |
Dim OV(2) As Double
|
| 726 |
Dim swSurf As sldworks.Surface
|
| 727 |
|
| 728 |
retval = PlanDessus.GetRefPlaneParams()
|
| 729 |
ret = retval
|
| 730 |
normalePlan(0) = ret(6) : normalePlan(1) = ret(7) : normalePlan(2) = ret(8)
|
| 731 |
swSurf = Me.lst_Faces.Item(0).GetSurface
|
| 732 |
retval = swSurf.CylinderParams() ' 7 doubles, les 3 premiers sont l'origine
|
| 733 |
ret2 = retval
|
| 734 |
OV(0) = ret2(0) - inter.x : OV(1) = ret2(1) - inter.y : OV(2) = ret2(2) - inter.z
|
| 735 |
|
| 736 |
' l'angle est le produit scalaire divisé par la norme des 2 vecteurs
|
| 737 |
Dim temp As Double = Outils_Math.Angle2Vecteurs(OV, normalePlan)
|
| 738 |
If (temp < Pi / 2) And (temp > -Pi / 2) Then Return False Else Return True
|
| 739 |
|
| 740 |
End Function
|
| 741 |
|
| 742 |
''' <summary>
|
| 743 |
''' Sub qui dessine (insère des lignes) sur le sketch en fonction de la forme de la poutre.
|
| 744 |
''' </summary>
|
| 745 |
''' <param name="Poutre"></param>
|
| 746 |
''' <param name="TranslationX"></param>
|
| 747 |
''' <param name="TranslationY"></param>
|
| 748 |
''' <param name="numero"></param>
|
| 749 |
''' <param name="swSketch"></param>
|
| 750 |
''' <param name="inter"></param>
|
| 751 |
''' <param name="MettreFI"></param>
|
| 752 |
''' <returns></returns>
|
| 753 |
''' <remarks></remarks>
|
| 754 |
Protected 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 InterAreteFace, ByRef MettreFI As Boolean) As Double()
|
| 755 |
' le sketch est déjà inséré, il faut juste mettre des swmodel.line ou autre
|
| 756 |
' doit retourner r() qui est un point situé à l'intérieur de la coupe
|
| 757 |
Dim sketchline As sldworks.SketchSegment
|
| 758 |
Dim longueur As Double
|
| 759 |
Dim r(2) As Double
|
| 760 |
Dim sk(1) As Double
|
| 761 |
Dim i As Integer
|
| 762 |
Dim Ligne() As Double = Nothing ' liste des lignes (4 valeurs par ligne)
|
| 763 |
Dim pt3() As Double
|
| 764 |
Dim Nomsection As String
|
| 765 |
|
| 766 |
MettreFI = True
|
| 767 |
|
| 768 |
' on doit activer le sketch avant d'utiliser la fonction getactivesketch
|
| 769 |
pt3 = Poutre.GetPoint3
|
| 770 |
longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
|
| 771 |
Dim IP(2) As Double ' IP est le vecteur directionnel
|
| 772 |
IP(0) = pt3(0) - inter.x : IP(1) = pt3(1) - inter.y : IP(2) = pt3(2) - inter.z
|
| 773 |
|
| 774 |
|
| 775 |
pt3 = Commun.TransfertModelSketch(swSketch, pt3)
|
| 776 |
longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
|
| 777 |
|
| 778 |
Nomsection = Poutre.GetNomSection
|
| 779 |
If Nomsection = "Rectangle" Or Nomsection = " Rectangle générique" Then ' un rectangle
|
| 780 |
Select Case numero
|
| 781 |
Case 1
|
| 782 |
Dim P(2, 1) As Double
|
| 783 |
P(0, 0) = 0
|
| 784 |
P(0, 1) = 0
|
| 785 |
P(1, 0) = Poutre.GetD1 / 2
|
| 786 |
P(1, 1) = -Poutre.GetD2 / 2
|
| 787 |
P(2, 0) = Poutre.GetD1 / 2
|
| 788 |
P(2, 1) = Poutre.GetD2 / 2
|
| 789 |
|
| 790 |
ReDim Ligne(11)
|
| 791 |
pt3(0) -= TranslationX
|
| 792 |
pt3(1) -= TranslationY
|
| 793 |
For i = 0 To 2
|
| 794 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 795 |
P(i, 0) += TranslationX
|
| 796 |
P(i, 1) += TranslationY
|
| 797 |
Next i
|
| 798 |
|
| 799 |
For i = 0 To 1
|
| 800 |
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)
|
| 801 |
Next i
|
| 802 |
Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(0, 0) : Ligne(11) = P(0, 1)
|
| 803 |
|
| 804 |
r(0) = inter.x + 5000 * Epsilon * IP(0)
|
| 805 |
r(1) = inter.y + 5000 * Epsilon * IP(1)
|
| 806 |
r(2) = inter.z + 5000 * Epsilon * IP(2)
|
| 807 |
|
| 808 |
Case 2
|
| 809 |
ReDim Ligne(19)
|
| 810 |
|
| 811 |
Dim p(4, 1) As Double
|
| 812 |
p(0, 0) = 0
|
| 813 |
p(0, 1) = 0
|
| 814 |
p(1, 0) = Poutre.GetD1 / 2
|
| 815 |
p(1, 1) = Poutre.GetD2 / 2
|
| 816 |
p(2, 0) = -Poutre.GetD1 / 2
|
| 817 |
p(2, 1) = Poutre.GetD2 / 2
|
| 818 |
p(3, 0) = -Poutre.GetD1 / 2
|
| 819 |
p(3, 1) = -Poutre.GetD2 / 2
|
| 820 |
p(4, 0) = Poutre.GetD1 / 2
|
| 821 |
p(4, 1) = -Poutre.GetD2 / 2
|
| 822 |
|
| 823 |
|
| 824 |
pt3(0) -= TranslationX
|
| 825 |
pt3(1) -= TranslationY
|
| 826 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 827 |
For i = 0 To 4
|
| 828 |
Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
|
| 829 |
p(i, 0) += TranslationX
|
| 830 |
p(i, 1) += TranslationY
|
| 831 |
Next i
|
| 832 |
|
| 833 |
For i = 0 To 3
|
| 834 |
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)
|
| 835 |
Next i
|
| 836 |
Ligne(16) = p(4, 0) : Ligne(17) = p(4, 1) : Ligne(18) = p(0, 0) : Ligne(19) = p(0, 1)
|
| 837 |
r(0) = inter.x - 5000 * Epsilon * IP(0)
|
| 838 |
r(1) = inter.y - 5000 * Epsilon * IP(1)
|
| 839 |
r(2) = inter.z - 5000 * Epsilon * IP(2)
|
| 840 |
|
| 841 |
End Select
|
| 842 |
MettreFI = True
|
| 843 |
ElseIf Left(Nomsection, 2) = "ST" Or Nomsection = " Tube carré générique" Then ' tube carré troué
|
| 844 |
Dim P(3, 1) As Double
|
| 845 |
Select Case numero
|
| 846 |
Case 1
|
| 847 |
P(0, 0) = Poutre.GetD1 / 2
|
| 848 |
P(0, 1) = -Poutre.GetD2 / 2
|
| 849 |
P(1, 0) = P(0, 0)
|
| 850 |
P(1, 1) = -P(0, 1)
|
| 851 |
P(2, 0) = -P(0, 0)
|
| 852 |
P(2, 1) = P(1, 1)
|
| 853 |
P(3, 0) = P(2, 0)
|
| 854 |
P(3, 1) = P(0, 1)
|
| 855 |
|
| 856 |
r(0) = P(0, 0) - 1000 * Epsilon
|
| 857 |
r(1) = 0 : r(2) = 0
|
| 858 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 859 |
r(0) += TranslationX
|
| 860 |
r(1) += TranslationY
|
| 861 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 862 |
|
| 863 |
pt3(0) -= TranslationX
|
| 864 |
pt3(1) -= TranslationY
|
| 865 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 866 |
For i = 0 To 3
|
| 867 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 868 |
P(i, 0) += TranslationX
|
| 869 |
P(i, 1) += TranslationY
|
| 870 |
Next i
|
| 871 |
|
| 872 |
ReDim Ligne(15)
|
| 873 |
Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
|
| 874 |
Ligne(4) = P(1, 0) : Ligne(5) = P(1, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
|
| 875 |
Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(3, 0) : Ligne(11) = P(3, 1)
|
| 876 |
Ligne(12) = P(3, 0) : Ligne(13) = P(3, 1) : Ligne(14) = P(0, 0) : Ligne(15) = P(0, 1)
|
| 877 |
MettreFI = False
|
| 878 |
|
| 879 |
Case 2
|
| 880 |
P(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
|
| 881 |
P(0, 1) = -Poutre.GetD2 / 2 + Poutre.GetD3
|
| 882 |
P(1, 0) = P(0, 0)
|
| 883 |
P(1, 1) = -P(0, 1)
|
| 884 |
P(2, 0) = -P(1, 0)
|
| 885 |
P(2, 1) = P(1, 1)
|
| 886 |
P(3, 0) = P(2, 0)
|
| 887 |
P(3, 1) = P(0, 1)
|
| 888 |
|
| 889 |
r(0) = P(0, 0) + 1000 * Epsilon
|
| 890 |
r(1) = 0 : r(2) = 0
|
| 891 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 892 |
r(0) += TranslationX
|
| 893 |
r(1) += TranslationY
|
| 894 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 895 |
|
| 896 |
pt3(0) -= TranslationX
|
| 897 |
pt3(1) -= TranslationY
|
| 898 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 899 |
For i = 0 To 3
|
| 900 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 901 |
P(i, 0) += TranslationX
|
| 902 |
P(i, 1) += TranslationY
|
| 903 |
Next i
|
| 904 |
|
| 905 |
ReDim Ligne(15)
|
| 906 |
Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
|
| 907 |
Ligne(4) = P(1, 0) : Ligne(5) = P(1, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
|
| 908 |
Ligne(8) = P(2, 0) : Ligne(9) = P(2, 1) : Ligne(10) = P(3, 0) : Ligne(11) = P(3, 1)
|
| 909 |
Ligne(12) = P(3, 0) : Ligne(13) = P(3, 1) : Ligne(14) = P(0, 0) : Ligne(15) = P(0, 1)
|
| 910 |
|
| 911 |
MettreFI = True ' lorsque l'on sort on met une face interne
|
| 912 |
|
| 913 |
End Select
|
| 914 |
|
| 915 |
|
| 916 |
ElseIf Left(Nomsection, 1) = "S" Or Nomsection = " Poutre en I générique" Then ' poutre en I de type S
|
| 917 |
Dim P(8, 1) As Double
|
| 918 |
|
| 919 |
Select Case numero
|
| 920 |
Case 1
|
| 921 |
Dim d As Double
|
| 922 |
d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
|
| 923 |
|
| 924 |
P(0, 0) = 0
|
| 925 |
P(0, 1) = 0
|
| 926 |
P(1, 0) = -d
|
| 927 |
P(1, 1) = -Poutre.GetD4 / 2.0R
|
| 928 |
P(2, 0) = (Poutre.GetD1 / 2) - Poutre.GetD3
|
| 929 |
P(2, 1) = -Poutre.GetD4 / 2.0R
|
| 930 |
P(3, 0) = P(2, 0)
|
| 931 |
P(3, 1) = -Poutre.GetD2 / 2
|
| 932 |
P(4, 0) = Poutre.GetD1 / 2
|
| 933 |
P(4, 1) = P(3, 1)
|
| 934 |
P(5, 0) = P(4, 0)
|
| 935 |
P(5, 1) = -P(4, 1)
|
| 936 |
P(6, 0) = P(3, 0)
|
| 937 |
P(6, 1) = -P(3, 1)
|
| 938 |
P(7, 0) = P(2, 0)
|
| 939 |
P(7, 1) = -P(2, 1)
|
| 940 |
P(8, 0) = P(1, 0)
|
| 941 |
P(8, 1) = -P(1, 1)
|
| 942 |
|
| 943 |
pt3(0) -= TranslationX
|
| 944 |
pt3(1) -= TranslationY
|
| 945 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 946 |
For i = 0 To 8
|
| 947 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 948 |
P(i, 0) += TranslationX
|
| 949 |
P(i, 1) += TranslationY
|
| 950 |
Next i
|
| 951 |
|
| 952 |
ReDim Ligne(35)
|
| 953 |
For i = 0 To 7
|
| 954 |
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)
|
| 955 |
Next i
|
| 956 |
Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
|
| 957 |
r(0) = inter.x + 5000 * Epsilon * IP(0)
|
| 958 |
r(1) = inter.y + 5000 * Epsilon * IP(1)
|
| 959 |
r(2) = inter.z + 5000 * Epsilon * IP(2)
|
| 960 |
Case 2
|
| 961 |
|
| 962 |
Dim d As Double
|
| 963 |
d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
|
| 964 |
|
| 965 |
P(0, 0) = 0
|
| 966 |
P(0, 1) = 0
|
| 967 |
|
| 968 |
P(1, 0) = -d
|
| 969 |
P(1, 1) = -Poutre.GetD4 / 2.0R
|
| 970 |
P(2, 0) = -((Poutre.GetD1 / 2) - Poutre.GetD3)
|
| 971 |
P(2, 1) = -Poutre.GetD4 / 2.0R
|
| 972 |
P(3, 0) = P(2, 0)
|
| 973 |
P(3, 1) = -Poutre.GetD2 / 2
|
| 974 |
P(4, 0) = -Poutre.GetD1 / 2
|
| 975 |
P(4, 1) = P(3, 1)
|
| 976 |
P(5, 0) = P(4, 0)
|
| 977 |
P(5, 1) = -P(4, 1)
|
| 978 |
P(6, 0) = P(3, 0)
|
| 979 |
P(6, 1) = -P(3, 1)
|
| 980 |
P(7, 0) = P(2, 0)
|
| 981 |
P(7, 1) = -P(2, 1)
|
| 982 |
P(8, 0) = P(1, 0)
|
| 983 |
P(8, 1) = -P(1, 1)
|
| 984 |
|
| 985 |
pt3(0) -= TranslationX
|
| 986 |
pt3(1) -= TranslationY
|
| 987 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 988 |
For i = 0 To 8
|
| 989 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 990 |
P(i, 0) += TranslationX
|
| 991 |
P(i, 1) += TranslationY
|
| 992 |
Next i
|
| 993 |
|
| 994 |
ReDim Ligne(35)
|
| 995 |
For i = 0 To 7
|
| 996 |
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)
|
| 997 |
Next i
|
| 998 |
Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
|
| 999 |
|
| 1000 |
r(0) = inter.x - 5000 * Epsilon * IP(0)
|
| 1001 |
r(1) = inter.y - 5000 * Epsilon * IP(1)
|
| 1002 |
r(2) = inter.z - 5000 * Epsilon * IP(2)
|
| 1003 |
|
| 1004 |
End Select
|
| 1005 |
MettreFI = True
|
| 1006 |
|
| 1007 |
ElseIf Left(Nomsection, 5) = "Tuyau" OrElse Nomsection = " Tuyau (Pipe) générique" Then ' le tube rond
|
| 1008 |
Dim p(4, 1) As Double
|
| 1009 |
p(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
|
| 1010 |
p(0, 1) = 0
|
| 1011 |
p(1, 0) = Poutre.GetD1 / 2
|
| 1012 |
p(1, 1) = 0
|
| 1013 |
p(2, 0) = -p(0, 0)
|
| 1014 |
p(2, 1) = 0
|
| 1015 |
p(3, 0) = -p(1, 0)
|
| 1016 |
p(3, 1) = 0
|
| 1017 |
p(4, 0) = 0
|
| 1018 |
p(4, 1) = 0
|
| 1019 |
|
| 1020 |
Select Case numero
|
| 1021 |
Case 1
|
| 1022 |
|
| 1023 |
r(0) = 0
|
| 1024 |
r(1) = Poutre.GetD1 / 2 - Poutre.GetD3 / 2 : r(2) = 0
|
| 1025 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1026 |
r(0) += TranslationX
|
| 1027 |
r(1) += TranslationY
|
| 1028 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1029 |
|
| 1030 |
pt3(0) -= TranslationX
|
| 1031 |
pt3(1) -= TranslationY
|
| 1032 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1033 |
For i = 0 To 4
|
| 1034 |
Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
|
| 1035 |
p(i, 0) += TranslationX
|
| 1036 |
p(i, 1) += TranslationY
|
| 1037 |
Next i
|
| 1038 |
|
| 1039 |
ReDim Ligne(7)
|
| 1040 |
Ligne(0) = p(0, 0) : Ligne(1) = p(0, 1) : Ligne(2) = p(1, 0) : Ligne(3) = p(1, 1)
|
| 1041 |
Ligne(4) = p(2, 0) : Ligne(5) = p(2, 1) : Ligne(6) = p(3, 0) : Ligne(7) = p(3, 1)
|
| 1042 |
swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(1, 0), p(1, 1), 0, p(3, 0), p(3, 1), 0, 1)
|
| 1043 |
swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(0, 0), p(0, 1), 0, p(2, 0), p(2, 1), 0, 1)
|
| 1044 |
MettreFI = True
|
| 1045 |
'Flag = 2
|
| 1046 |
Case 2
|
| 1047 |
|
| 1048 |
r(0) = 0
|
| 1049 |
r(1) = -Poutre.GetD1 / 2 + Poutre.GetD3 / 2 : r(2) = 0
|
| 1050 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1051 |
r(0) += TranslationX
|
| 1052 |
r(1) += TranslationY
|
| 1053 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1054 |
|
| 1055 |
pt3(0) -= TranslationX
|
| 1056 |
pt3(1) -= TranslationY
|
| 1057 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1058 |
For i = 0 To 4
|
| 1059 |
Outils_Math.Rotation2D(pt3, p(i, 0), p(i, 1))
|
| 1060 |
p(i, 0) += TranslationX
|
| 1061 |
p(i, 1) += TranslationY
|
| 1062 |
Next i
|
| 1063 |
|
| 1064 |
ReDim Ligne(7)
|
| 1065 |
Ligne(0) = p(0, 0) : Ligne(1) = p(0, 1) : Ligne(2) = p(1, 0) : Ligne(3) = p(1, 1)
|
| 1066 |
Ligne(4) = p(2, 0) : Ligne(5) = p(2, 1) : Ligne(6) = p(3, 0) : Ligne(7) = p(3, 1)
|
| 1067 |
swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(1, 0), p(1, 1), 0, p(3, 0), p(3, 1), 0, -1)
|
| 1068 |
swModel.CreateArc2(p(4, 0), p(4, 1), 0, p(0, 0), p(0, 1), 0, p(2, 0), p(2, 1), 0, -1)
|
| 1069 |
'MettreFI = True ' lorsque l'on sort on met une face interne
|
| 1070 |
MettreFI = False
|
| 1071 |
Me.Flag = 2
|
| 1072 |
'Case 1 ' le cercle extérieur
|
| 1073 |
' swModel.CreateCircleByRadius2(TranslationX, TranslationY, 0, Poutre.GetD1 / 2)
|
| 1074 |
' MettreFI = False
|
| 1075 |
' r(0) = 0 : r(1) = 0 : r(2) = 0
|
| 1076 |
' r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1077 |
'Case 2
|
| 1078 |
' swModel.CreateCircleByRadius2(TranslationX, TranslationY, 0, (Poutre.GetD1 / 2) - Poutre.GetD3)
|
| 1079 |
' r(0) = (Poutre.GetD1 / 2 - (Poutre.GetD3 / 2))
|
| 1080 |
' r(1) = 0 : r(2) = 0
|
| 1081 |
' r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1082 |
' MettreFI = True
|
| 1083 |
End Select
|
| 1084 |
|
| 1085 |
ElseIf Left(Poutre.GetNomSection, 2) = "Cy" Or Nomsection = " Cylindrique (Rod) générique" Then ' Pipe,
|
| 1086 |
Dim P(2, 1) As Double
|
| 1087 |
Dim d As Double, e As Double
|
| 1088 |
d = Poutre.GetD1 / 4 ' Math.Sin(30) ( et on doit diviser le diamètre par 2)
|
| 1089 |
e = Poutre.GetD1 * Math.Sqrt(3) / 4 ' cos (30°)
|
| 1090 |
|
| 1091 |
P(0, 0) = 0
|
| 1092 |
P(0, 1) = 0
|
| 1093 |
P(1, 0) = d
|
| 1094 |
P(1, 1) = -e
|
| 1095 |
P(2, 0) = d
|
| 1096 |
P(2, 1) = e
|
| 1097 |
|
| 1098 |
Select Case numero
|
| 1099 |
Case 1
|
| 1100 |
r(0) = P(0, 0) + 1000 * Epsilon
|
| 1101 |
r(1) = 0 : r(2) = 0
|
| 1102 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1103 |
r(0) += TranslationX
|
| 1104 |
r(1) += TranslationY
|
| 1105 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1106 |
pt3(0) -= TranslationX
|
| 1107 |
pt3(1) -= TranslationY
|
| 1108 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1109 |
For i = 0 To 2
|
| 1110 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1111 |
P(i, 0) += TranslationX
|
| 1112 |
P(i, 1) += TranslationY
|
| 1113 |
Next i
|
| 1114 |
ReDim Ligne(7)
|
| 1115 |
Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
|
| 1116 |
Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
|
| 1117 |
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
|
| 1118 |
|
| 1119 |
Case 2
|
| 1120 |
r(0) = P(0, 0) - 1000 * Epsilon
|
| 1121 |
r(1) = 0 : r(2) = 0
|
| 1122 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1123 |
r(0) += TranslationX
|
| 1124 |
r(1) += TranslationY
|
| 1125 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1126 |
|
| 1127 |
pt3(0) -= TranslationX
|
| 1128 |
pt3(1) -= TranslationY
|
| 1129 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1130 |
For i = 0 To 2
|
| 1131 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1132 |
P(i, 0) += TranslationX
|
| 1133 |
P(i, 1) += TranslationY
|
| 1134 |
Next i
|
| 1135 |
ReDim Ligne(7)
|
| 1136 |
Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
|
| 1137 |
Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
|
| 1138 |
|
| 1139 |
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
|
| 1140 |
|
| 1141 |
End Select
|
| 1142 |
MettreFI = True
|
| 1143 |
|
| 1144 |
|
| 1145 |
ElseIf Left(Nomsection, 1) = "C" Or Nomsection = " Poutre en C générique" Then ' le channel
|
| 1146 |
Dim P(7, 1) As Double
|
| 1147 |
|
| 1148 |
Select Case numero
|
| 1149 |
Case 1 ' le C au complet
|
| 1150 |
|
| 1151 |
P(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
|
| 1152 |
P(0, 1) = Poutre.GetD5
|
| 1153 |
P(1, 0) = P(0, 0)
|
| 1154 |
P(1, 1) = Poutre.GetD5 + Poutre.GetD4 - Poutre.GetD2
|
| 1155 |
P(2, 0) = Poutre.GetD1 / 2
|
| 1156 |
P(2, 1) = P(1, 1)
|
| 1157 |
P(3, 0) = P(2, 0)
|
| 1158 |
P(3, 1) = P(1, 1) + Poutre.GetD2
|
| 1159 |
P(4, 0) = -P(3, 0)
|
| 1160 |
P(4, 1) = P(3, 1)
|
| 1161 |
P(5, 0) = P(4, 0)
|
| 1162 |
P(5, 1) = P(1, 1)
|
| 1163 |
P(6, 0) = -P(1, 0)
|
| 1164 |
P(6, 1) = P(5, 1)
|
| 1165 |
P(7, 0) = -P(0, 0)
|
| 1166 |
P(7, 1) = P(0, 1)
|
| 1167 |
|
| 1168 |
r(0) = P(0, 0) + 1000 * Epsilon
|
| 1169 |
r(1) = P(0, 1) : r(2) = 0
|
| 1170 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1171 |
r(0) += TranslationX
|
| 1172 |
r(1) += TranslationY
|
| 1173 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1174 |
|
| 1175 |
pt3(0) -= TranslationX
|
| 1176 |
pt3(1) -= TranslationY
|
| 1177 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1178 |
For i = 0 To 7
|
| 1179 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1180 |
P(i, 0) += TranslationX
|
| 1181 |
P(i, 1) += TranslationY
|
| 1182 |
Next i
|
| 1183 |
|
| 1184 |
ReDim Ligne(35)
|
| 1185 |
For i = 0 To 6
|
| 1186 |
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)
|
| 1187 |
Next i
|
| 1188 |
Ligne(28) = P(7, 0) : Ligne(29) = P(7, 1) : Ligne(30) = P(0, 0) : Ligne(31) = P(0, 1)
|
| 1189 |
|
| 1190 |
MettreFI = False
|
| 1191 |
Me.Flag = 2
|
| 1192 |
Case 2
|
| 1193 |
MettreFI = False ' Attention, peut planter à cause de ça.
|
| 1194 |
End Select
|
| 1195 |
|
| 1196 |
ElseIf Left(Nomsection, 1) = "L" Or Nomsection = " Poutre en L générique" Then ' l'Angle en L
|
| 1197 |
Dim P(5, 1) As Double
|
| 1198 |
|
| 1199 |
Select Case numero
|
| 1200 |
Case 1 ' le C au complet
|
| 1201 |
|
| 1202 |
P(0, 0) = -Poutre.GetD5 + Poutre.GetD1
|
| 1203 |
P(0, 1) = -Poutre.GetD6 + Poutre.GetD4
|
| 1204 |
P(1, 0) = -Poutre.GetD5 + Poutre.GetD3
|
| 1205 |
P(1, 1) = P(0, 1)
|
| 1206 |
P(2, 0) = P(1, 0)
|
| 1207 |
P(2, 1) = -Poutre.GetD6 + Poutre.GetD2
|
| 1208 |
P(3, 0) = -Poutre.GetD5
|
| 1209 |
P(3, 1) = P(2, 1)
|
| 1210 |
P(4, 0) = P(3, 0)
|
| 1211 |
P(4, 1) = -Poutre.GetD6
|
| 1212 |
P(5, 0) = P(0, 0)
|
| 1213 |
P(5, 1) = P(4, 1)
|
| 1214 |
|
| 1215 |
r(0) = P(1, 0) - 1000 * Epsilon
|
| 1216 |
r(1) = 0 : r(2) = 0
|
| 1217 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1218 |
r(0) += TranslationX
|
| 1219 |
r(1) += TranslationY
|
| 1220 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1221 |
|
| 1222 |
pt3(0) -= TranslationX
|
| 1223 |
pt3(1) -= TranslationY
|
| 1224 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1225 |
For i = 0 To 5
|
| 1226 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1227 |
P(i, 0) += TranslationX
|
| 1228 |
P(i, 1) += TranslationY
|
| 1229 |
Next i
|
| 1230 |
|
| 1231 |
ReDim Ligne(35)
|
| 1232 |
For i = 0 To 4
|
| 1233 |
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)
|
| 1234 |
Next i
|
| 1235 |
Ligne(20) = P(5, 0) : Ligne(21) = P(5, 1) : Ligne(22) = P(0, 0) : Ligne(23) = P(0, 1)
|
| 1236 |
|
| 1237 |
MettreFI = False ' lorsque l'on sort on met une face interne
|
| 1238 |
Me.Flag = 2
|
| 1239 |
Case 2
|
| 1240 |
MettreFI = False ' Attention, peut planter à cause de ça.
|
| 1241 |
End Select
|
| 1242 |
|
| 1243 |
|
| 1244 |
ElseIf Left(Nomsection, 1) = "T" Or Nomsection = " Poutre en T générique" Then ' le T
|
| 1245 |
Select Case numero
|
| 1246 |
Case 1
|
| 1247 |
Dim P(8, 1) As Double
|
| 1248 |
Dim d As Double
|
| 1249 |
d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
|
| 1250 |
|
| 1251 |
|
| 1252 |
P(0, 0) = 0
|
| 1253 |
P(0, 1) = 0
|
| 1254 |
P(1, 0) = d
|
| 1255 |
P(1, 1) = -Poutre.GetD4 / 2.0R
|
| 1256 |
P(2, 0) = -(Poutre.GetD1 - Poutre.GetD5 - Poutre.GetD3)
|
| 1257 |
P(2, 1) = -Poutre.GetD4 / 2.0R
|
| 1258 |
P(3, 0) = P(2, 0)
|
| 1259 |
P(3, 1) = -Poutre.GetD2 / 2
|
| 1260 |
P(4, 0) = -Poutre.GetD1 + Poutre.GetD5
|
| 1261 |
P(4, 1) = P(3, 1)
|
| 1262 |
P(5, 0) = P(4, 0)
|
| 1263 |
P(5, 1) = -P(4, 1)
|
| 1264 |
P(6, 0) = P(3, 0)
|
| 1265 |
P(6, 1) = -P(3, 1)
|
| 1266 |
P(7, 0) = P(2, 0)
|
| 1267 |
P(7, 1) = -P(2, 1)
|
| 1268 |
P(8, 0) = P(1, 0)
|
| 1269 |
P(8, 1) = -P(1, 1)
|
| 1270 |
|
| 1271 |
r(0) = P(0, 0) - 1000 * Epsilon
|
| 1272 |
r(1) = 0 : r(2) = 0
|
| 1273 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1274 |
r(0) += TranslationX
|
| 1275 |
r(1) += TranslationY
|
| 1276 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1277 |
|
| 1278 |
pt3(0) -= TranslationX
|
| 1279 |
pt3(1) -= TranslationY
|
| 1280 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1281 |
For i = 0 To 8
|
| 1282 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1283 |
P(i, 0) += TranslationX
|
| 1284 |
P(i, 1) += TranslationY
|
| 1285 |
Next i
|
| 1286 |
|
| 1287 |
ReDim Ligne(35)
|
| 1288 |
For i = 0 To 7
|
| 1289 |
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)
|
| 1290 |
Next i
|
| 1291 |
Ligne(32) = P(8, 0) : Ligne(33) = P(8, 1) : Ligne(34) = P(0, 0) : Ligne(35) = P(0, 1)
|
| 1292 |
|
| 1293 |
Case 2
|
| 1294 |
Dim P(4, 1) As Double
|
| 1295 |
Dim d As Double
|
| 1296 |
d = Poutre.GetD4 * 0.8660254038 ' section.D4 / (2 * tan(30))
|
| 1297 |
|
| 1298 |
P(0, 0) = 0
|
| 1299 |
P(0, 1) = 0
|
| 1300 |
|
| 1301 |
P(1, 0) = d
|
| 1302 |
P(1, 1) = -Poutre.GetD4 / 2.0R
|
| 1303 |
P(2, 0) = Poutre.GetD5
|
| 1304 |
P(2, 1) = -Poutre.GetD4 / 2.0R
|
| 1305 |
P(3, 0) = P(2, 0)
|
| 1306 |
P(3, 1) = Poutre.GetD4 / 2
|
| 1307 |
P(4, 0) = P(1, 0)
|
| 1308 |
P(4, 1) = P(3, 1)
|
| 1309 |
|
| 1310 |
r(0) = P(0, 0) + 1000 * Epsilon
|
| 1311 |
r(1) = 0 : r(2) = 0
|
| 1312 |
Outils_Math.Rotation2D(pt3, r(0), r(1))
|
| 1313 |
r(0) += TranslationX
|
| 1314 |
r(1) += TranslationY
|
| 1315 |
r = Commun.TransfertSketchToModel(swSketch, r)
|
| 1316 |
|
| 1317 |
pt3(0) -= TranslationX
|
| 1318 |
pt3(1) -= TranslationY
|
| 1319 |
pt3(0) /= longueur : pt3(1) /= longueur
|
| 1320 |
For i = 0 To 4
|
| 1321 |
Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
|
| 1322 |
P(i, 0) += TranslationX
|
| 1323 |
P(i, 1) += TranslationY
|
| 1324 |
Next i
|
| 1325 |
|
| 1326 |
ReDim Ligne(19)
|
| 1327 |
For i = 0 To 3
|
| 1328 |
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)
|
| 1329 |
Next i
|
| 1330 |
Ligne(16) = P(4, 0) : Ligne(17) = P(4, 1) : Ligne(18) = P(0, 0) : Ligne(19) = P(0, 1)
|
| 1331 |
|
| 1332 |
End Select
|
| 1333 |
MettreFI = True
|
| 1334 |
|
| 1335 |
|
| 1336 |
Else
|
| 1337 |
MsgBox("Section de poutre non reconnu!", MsgBoxStyle.Critical, "Commun.DessineSectionPoutre")
|
| 1338 |
End If
|
| 1339 |
|
| 1340 |
|
| 1341 |
If Not Ligne Is Nothing Then
|
| 1342 |
For i = 0 To UBound(Ligne) Step 4
|
| 1343 |
sketchline = swModel.CreateLine2(Ligne(i), Ligne(i + 1), 0, Ligne(i + 2), Ligne(i + 3), 0)
|
| 1344 |
Next i
|
| 1345 |
End If
|
| 1346 |
|
| 1347 |
Return r
|
| 1348 |
|
| 1349 |
End Function
|
| 1350 |
|
| 1351 |
Public Function SwFace() As sldworks.Face2 ' retourne la première face de la liste (dans la partie traitement, ce sera la seule...)
|
| 1352 |
Return Me.lst_Faces.Item(0)
|
| 1353 |
End Function
|
| 1354 |
|
| 1355 |
Public Function IsFaceInterne(ByRef swface As sldworks.Face2) As Boolean
|
| 1356 |
Dim attr As sldworks.Attribute
|
| 1357 |
Dim SwEnt As sldworks.Entity
|
| 1358 |
SwEnt = swface
|
| 1359 |
attr = SwEnt.FindAttribute(DefAttrFaceInterne, 0)
|
| 1360 |
If attr Is Nothing Then Return False Else Return True
|
| 1361 |
End Function
|
| 1362 |
|
| 1363 |
''' <summary>
|
| 1364 |
''' Fonction qui retourne un tableau de Sldworks.edge (et non slyedges)
|
| 1365 |
''' </summary>
|
| 1366 |
''' <returns>Un tableau de Edges</returns>
|
| 1367 |
''' <remarks></remarks>
|
| 1368 |
Public Function GetAretes() As sldworks.Edge()
|
| 1369 |
Dim face As sldworks.Face2
|
| 1370 |
Dim arete As sldworks.Edge = Nothing
|
| 1371 |
Dim temp2 As Collections.Generic.List(Of sldworks.Edge)
|
| 1372 |
Dim lst As New Collections.Generic.List(Of sldworks.Edge)
|
| 1373 |
|
| 1374 |
For Each face In Me.lst_Faces
|
| 1375 |
temp2 = GetArete1Face(face)
|
| 1376 |
For Each arete In temp2
|
| 1377 |
lst.Add(arete)
|
| 1378 |
Next arete
|
| 1379 |
Next face
|
| 1380 |
|
| 1381 |
Return lst.ToArray
|
| 1382 |
End Function
|
| 1383 |
|
| 1384 |
Private Function GetArete1Face(ByRef Face As sldworks.Face2) As Collections.Generic.List(Of sldworks.Edge)
|
| 1385 |
Dim vArete As Object
|
| 1386 |
Dim a As sldworks.Edge
|
| 1387 |
Dim arete() As sldworks.Edge
|
| 1388 |
Dim lst As New Collections.Generic.List(Of sldworks.Edge)
|
| 1389 |
|
| 1390 |
ReDim arete(Face.GetEdgeCount - 1)
|
| 1391 |
vArete = Face.GetEdges()
|
| 1392 |
|
| 1393 |
For Each a In vArete
|
| 1394 |
lst.Add(a)
|
| 1395 |
Next
|
| 1396 |
|
| 1397 |
Return lst
|
| 1398 |
End Function
|
| 1399 |
|
| 1400 |
Public Overrides Sub Selectionner(Optional ByVal Mark As Integer = 0, Optional ByRef append As Boolean = True)
|
| 1401 |
Dim swent As sldworks.Entity
|
| 1402 |
Dim swface As sldworks.Face2
|
| 1403 |
|
| 1404 |
For Each swface In lst_Faces
|
| 1405 |
swent = swface
|
| 1406 |
swent.Select2(append, Mark)
|
| 1407 |
Next swface
|
| 1408 |
End Sub
|
| 1409 |
|
| 1410 |
|
| 1411 |
''' <summary>
|
| 1412 |
''' Sélectionne toutes les faces dans la liste de faces
|
| 1413 |
''' </summary>
|
| 1414 |
''' <param name="Mark"></param>
|
| 1415 |
''' <param name="Append"></param>
|
| 1416 |
''' <remarks></remarks>
|
| 1417 |
Public Sub SelectionnerToutes(Optional ByRef Mark As Integer = 0, Optional ByRef Append As Boolean = True)
|
| 1418 |
Dim swFace As sldworks.Face2
|
| 1419 |
|
| 1420 |
Dim swent As sldworks.Entity
|
| 1421 |
If Append = False Then swModel.ClearSelection2(True)
|
| 1422 |
For Each swFace In Me.lst_Faces
|
| 1423 |
swent = swFace : swent.Select2(True, Mark)
|
| 1424 |
Next
|
| 1425 |
|
| 1426 |
End Sub
|
| 1427 |
|
| 1428 |
|
| 1429 |
|
| 1430 |
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
|
| 1431 |
swModel.SelectedFaceProperties(RGB(rouge, Vert, Bleu), Ambient, Diffuse, Specular, Shininess, Transparency, Emission, False, "")
|
| 1432 |
Return 1
|
| 1433 |
End Function
|
| 1434 |
|
| 1435 |
|
| 1436 |
Public Sub AjouterFace(ByRef face As sldworks.Face2)
|
| 1437 |
Dim testface As sldworks.Face2
|
| 1438 |
Dim faultentity As sldworks.FaultEntity
|
| 1439 |
Dim swent As sldworks.Entity
|
| 1440 |
|
| 1441 |
If Not Me.lst_Faces.Contains(face) Then Me.lst_Faces.Add(face)
|
| 1442 |
|
| 1443 |
' vérifier que les anciennes faces sont toujours ok...
|
| 1444 |
'For Each testface In Me.lst_Faces
|
| 1445 |
' faultentity = testface.Check
|
| 1446 |
' If Not faultentity.Count = 0 Then ' on a un problème avec la face....
|
| 1447 |
' If lst_Faces.Contains(testface) Then
|
| 1448 |
' Try
|
| 1449 |
' lst_Faces.Remove(testface)
|
| 1450 |
' Catch ex As Exception
|
| 1451 |
|
| 1452 |
' End Try
|
| 1453 |
' End If
|
| 1454 |
|
| 1455 |
'Dim i As Integer
|
| 1456 |
'For i = 0 To faultentity.Count - 1
|
| 1457 |
' swent = faultentity.Entity(i)
|
| 1458 |
' If Not swent Is Nothing Then
|
| 1459 |
' swent.Select4(True, Nothing)
|
| 1460 |
' End If
|
| 1461 |
' Debug.Print(" Fault[" & i & "] = " & swent.errorCode(i))
|
| 1462 |
'Next i
|
| 1463 |
'End If
|
| 1464 |
'Next testface
|
| 1465 |
|
| 1466 |
|
| 1467 |
End Sub
|
| 1468 |
|
| 1469 |
|
| 1470 |
'Public Function DonnerFaces() As SldWorks.Face2()
|
| 1471 |
' 'Dim temp() As SldWorks.Face2
|
| 1472 |
' 'Dim i As Integer
|
| 1473 |
|
| 1474 |
' 'ReDim temp(lst_Faces.Count - 1)
|
| 1475 |
|
| 1476 |
' 'For i = 1 To lst_Faces.Count
|
| 1477 |
' ' temp(i - 1) = lst_Faces.Item(i)
|
| 1478 |
' 'Next
|
| 1479 |
|
| 1480 |
' Return lst_Faces.ToArray
|
| 1481 |
'End Function
|
| 1482 |
|
| 1483 |
|
| 1484 |
|
| 1485 |
''' <summary>
|
| 1486 |
''' Function qui retourne un pointeur vers la face
|
| 1487 |
''' </summary>
|
| 1488 |
''' <returns></returns>
|
| 1489 |
''' <remarks></remarks>
|
| 1490 |
Public Function GetFace() As sldworks.Face2
|
| 1491 |
Return Me.SwFace
|
| 1492 |
End Function
|
| 1493 |
|
| 1494 |
''' <summary>
|
| 1495 |
''' Fonction qui redonne toutes les Faces contenues dans cette face
|
| 1496 |
''' </summary>
|
| 1497 |
''' <returns></returns>
|
| 1498 |
''' <remarks></remarks>
|
| 1499 |
Public Function GetFaces() As sldworks.Face2()
|
| 1500 |
Return Me.lst_Faces.ToArray
|
| 1501 |
End Function
|
| 1502 |
|
| 1503 |
''' <summary>
|
| 1504 |
''' Sub qui renvoie les coordonnées min et max des valeurs U et V
|
| 1505 |
''' </summary>
|
| 1506 |
''' <param name="Umin"></param>
|
| 1507 |
''' <param name="UMax"></param>
|
| 1508 |
''' <param name="VMin"></param>
|
| 1509 |
''' <param name="VMax"></param>
|
| 1510 |
''' <remarks></remarks>
|
| 1511 |
Public Sub UVMinMax(ByRef Umin As Double, ByRef UMax As Double, ByRef VMin As Double, ByRef VMax As Double)
|
| 1512 |
Dim vBounds As Object
|
| 1513 |
vBounds = SwFace.GetUVBounds()
|
| 1514 |
|
| 1515 |
Umin = vBounds(0)
|
| 1516 |
UMax = vBounds(1)
|
| 1517 |
|
| 1518 |
VMin = vBounds(2)
|
| 1519 |
VMax = vBounds(3)
|
| 1520 |
End Sub
|
| 1521 |
|
| 1522 |
''' <summary>
|
| 1523 |
''' Calcule la position du point selon les U et V
|
| 1524 |
''' </summary>
|
| 1525 |
''' <param name="U"></param>
|
| 1526 |
''' <param name="V"></param>
|
| 1527 |
''' <param name="X"></param>
|
| 1528 |
''' <param name="Y"></param>
|
| 1529 |
''' <param name="Z"></param>
|
| 1530 |
''' <returns>Vrai si le point est sur la face, faux sinon</returns>
|
| 1531 |
''' <remarks>Retourne X, Y et Z même si le point n'est pas sur la face (mais sur la surface) </remarks>
|
| 1532 |
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
|
| 1533 |
Dim surf As sldworks.Surface
|
| 1534 |
Dim vEv As Object, vpoint As Object
|
| 1535 |
Dim P(2) As Double
|
| 1536 |
|
| 1537 |
surf = SwFace.GetSurface()
|
| 1538 |
|
| 1539 |
vEv = surf.Evaluate(U, V, 0, 0)
|
| 1540 |
|
| 1541 |
X = vEv(0) : Y = vEv(1) : Z = vEv(2)
|
| 1542 |
|
| 1543 |
vpoint = SwFace.GetClosestPointOn(X, Y, Z)
|
| 1544 |
|
| 1545 |
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
|
| 1546 |
|
| 1547 |
End Function
|
| 1548 |
|
| 1549 |
''' <summary>
|
| 1550 |
''' Function qui calcule la normale d'une face au point X,Y,Z.
|
| 1551 |
''' </summary>
|
| 1552 |
''' <param name="X"></param>
|
| 1553 |
''' <param name="Y"></param>
|
| 1554 |
''' <param name="Z"></param>
|
| 1555 |
''' <returns>Un tableau de 3 doubles correspondant à la normale</returns>
|
| 1556 |
''' <remarks></remarks>
|
| 1557 |
Public Function Normale(ByRef X As Double, ByRef Y As Double, ByRef Z As Double) As Double()
|
| 1558 |
Dim surf As sldworks.Surface
|
| 1559 |
Dim vtemp As Object
|
| 1560 |
Dim temp() As Double
|
| 1561 |
Dim sens As Boolean
|
| 1562 |
|
| 1563 |
surf = SwFace.GetSurface
|
| 1564 |
If surf.IsPlane Then vtemp = SwFace.Normal : temp = vtemp : Return temp ' si la face est plane alors c'est ok, sinon il faut travailler...
|
| 1565 |
|
| 1566 |
vtemp = surf.EvaluateAtPoint(X, Y, Z)
|
| 1567 |
ReDim temp(2)
|
| 1568 |
' la normale de la face pointe AWAY from the body
|
| 1569 |
sens = SwFace.FaceInSurfaceSense() 'TRUE if face normal and surface normal are in the opposite direction and FALSE if they are in the same direction
|
| 1570 |
|
| 1571 |
If sens Then ' on doit inverser
|
| 1572 |
temp(0) = -vtemp(0) : temp(1) = -vtemp(1) : temp(2) = -vtemp(2)
|
| 1573 |
Else
|
| 1574 |
temp(0) = vtemp(0) : temp(1) = vtemp(1) : temp(2) = vtemp(2)
|
| 1575 |
End If
|
| 1576 |
Return temp
|
| 1577 |
|
| 1578 |
End Function
|
| 1579 |
|
| 1580 |
''' <summary>
|
| 1581 |
''' Met un attribut de face interne
|
| 1582 |
''' </summary>
|
| 1583 |
''' <param name="face">La face sur laquelle mettre l'attribut</param>
|
| 1584 |
''' <param name="Valeur">La taille de maille suggérée</param>
|
| 1585 |
''' <param name="poutre">Si vrai alors on a une poutre, sinon une coque</param>
|
| 1586 |
''' <returns>Le numéro de l'attribut (si jamais c'est important)</returns>
|
| 1587 |
''' <remarks>Attention au signe de la valeur</remarks>
|
| 1588 |
Public Function MettreAttributFaceInterne(ByRef face As sldworks.Face2, Optional ByRef Valeur As Double = 0, Optional ByVal poutre As Boolean = True) As Integer
|
| 1589 |
Dim no As Integer = 0
|
| 1590 |
Dim nom As String = "FaceInterne" & no
|
| 1591 |
Dim swent As sldworks.Entity
|
| 1592 |
Dim attr As sldworks.Attribute
|
| 1593 |
Dim p As sldworks.Parameter
|
| 1594 |
|
| 1595 |
swent = face 'Me.SwFace
|
| 1596 |
|
| 1597 |
attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
|
| 1598 |
If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom, 0, 2) ' 0 = swThisconfig
|
| 1599 |
While attr Is Nothing
|
| 1600 |
no += 1
|
| 1601 |
nom = "FaceInterne" & CStr(no)
|
| 1602 |
attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom, 0, 2)
|
| 1603 |
End While
|
| 1604 |
p = attr.GetParameter("FI")
|
| 1605 |
p.SetDoubleValue(Valeur)
|
| 1606 |
|
| 1607 |
p = attr.GetParameter("Po")
|
| 1608 |
If poutre Then
|
| 1609 |
p.SetDoubleValue(0) ' poutre
|
| 1610 |
Else
|
| 1611 |
p.SetDoubleValue(1) ' coque
|
| 1612 |
End If
|
| 1613 |
|
| 1614 |
|
| 1615 |
GererDossiers("FaceInternes", nom)
|
| 1616 |
Return no
|
| 1617 |
End Function
|
| 1618 |
|
| 1619 |
''' <summary>
|
| 1620 |
''' Si la face est une face interne,alors on écrit les points POG dans le fichier
|
| 1621 |
''' </summary>
|
| 1622 |
''' <remarks></remarks>
|
| 1623 |
Public Sub MettrePointSurPOG(ByVal fichier As System.IO.StreamWriter)
|
| 1624 |
' 2 - Si la face a un attribut de faceInterne on:
|
| 1625 |
Dim ENG As Double = Commun.ÉcartNodal
|
| 1626 |
Dim EcartSouhaite As Double
|
| 1627 |
Dim ratio As Double
|
| 1628 |
|
| 1629 |
|
| 1630 |
If Me.PossedeAttributFaceInterne Then
|
| 1631 |
' 2.1 Détermine l'écart nodal à cette face ( en fait, le ratio... )
|
| 1632 |
|
| 1633 |
' là on a 2 options,
|
| 1634 |
' a) on utilise le rayon hydraulique: 4* Surface / Périmètre
|
| 1635 |
EcartSouhaite = Me.GrosseurMailleFaceInterne ' 4 * Me.Aire / Me.Perimetre
|
| 1636 |
ratio = EcartSouhaite / ENG
|
| 1637 |
|
| 1638 |
|
| 1639 |
If ratio > 0.75 Then ratio = 0.75 ' ?!? on s'assure d'avoir un minimum de rafinement...
|
| 1640 |
' b) On analyse la tessellation et on prend la plus petite longueur de triangle...
|
| 1641 |
|
| 1642 |
' 2.2 Créé une série de points [ sur chaque point de la tessellation :-) ] mais là on va avoir un tas de doubles... Update. La tessellation n emarche pas, sur des faces «carrées» il y a des zones trop vides
|
| 1643 |
' On va mettre des points sur le contour des faces. un point va automatiquement se retrouver au milieu
|
| 1644 |
|
| 1645 |
Dim objArete As Object = Me.SwFace.GetEdges
|
| 1646 |
Dim points As New Collections.Generic.List(Of Point)
|
| 1647 |
Dim p As Point
|
| 1648 |
Dim x, y, z As Double
|
| 1649 |
|
| 1650 |
|
| 1651 |
For Each swArete As sldworks.Edge In objArete
|
| 1652 |
Dim e As New SuperArete(swArete, True)
|
| 1653 |
Dim LongueurArete As Double = e.Longueur
|
| 1654 |
Dim nbSeg As Integer = Int(LongueurArete / EcartSouhaite / 2) : If nbSeg < 2 Then nbSeg = 2
|
| 1655 |
Dim dt As Double = (e.GetTMax - e.GetTMin) / nbSeg
|
| 1656 |
Dim T As Double = e.GetTMin
|
| 1657 |
|
| 1658 |
|
| 1659 |
' les points sur les arètes
|
| 1660 |
|
| 1661 |
For s As Integer = 1 To nbSeg - 1
|
| 1662 |
T += dt
|
| 1663 |
e.Evaluer(T, x, y, z)
|
| 1664 |
p = New Point(x, y, z) : points.Add(p)
|
| 1665 |
Next s
|
| 1666 |
|
| 1667 |
|
| 1668 |
|
| 1669 |
' les points sur les sommets
|
| 1670 |
Dim swSommets() As sldworks.Vertex = Me.GetSommets
|
| 1671 |
Dim es As SuperSommet
|
| 1672 |
For Each sommet As sldworks.Vertex In swSommets
|
| 1673 |
es = New SuperSommet(sommet, True)
|
| 1674 |
p = New Point(es.X, es.Y, es.Z) : points.Add(p)
|
| 1675 |
Next
|
| 1676 |
e = Nothing
|
| 1677 |
es = Nothing
|
| 1678 |
|
| 1679 |
Next
|
| 1680 |
|
| 1681 |
For Each p In points
|
| 1682 |
' 2.3 enregistre ces points dans le fichier.
|
| 1683 |
fichier.WriteLine(CStr(p) & " " & ratio & " " & "4" & " " & "0")
|
| 1684 |
Next p
|
| 1685 |
ENG = 1 ' pour y mettre un point d'arrêt
|
| 1686 |
End If
|
| 1687 |
End Sub
|
| 1688 |
|
| 1689 |
|
| 1690 |
''' <summary>
|
| 1691 |
''' Retourne un tableau de swSommets
|
| 1692 |
''' </summary>
|
| 1693 |
''' <returns></returns>
|
| 1694 |
''' <remarks></remarks>
|
| 1695 |
Public Function GetSommets() As sldworks.Vertex()
|
| 1696 |
Dim lst_sommets As New Collections.Generic.List(Of sldworks.Vertex)
|
| 1697 |
Dim swSommet As sldworks.Vertex
|
| 1698 |
Dim objArete As Object = Me.SwFace.GetEdges()
|
| 1699 |
|
| 1700 |
For Each arete As sldworks.Edge In objArete
|
| 1701 |
swSommet = arete.GetStartVertex() : If swSommet Is Nothing Then Continue For
|
| 1702 |
If Not lst_sommets.Contains(swSommet) Then lst_sommets.Add(swSommet)
|
| 1703 |
swSommet = arete.GetEndVertex()
|
| 1704 |
If Not lst_sommets.Contains(swSommet) Then lst_sommets.Add(swSommet)
|
| 1705 |
Next arete
|
| 1706 |
Return lst_sommets.ToArray
|
| 1707 |
End Function
|
| 1708 |
|
| 1709 |
|
| 1710 |
''' <summary>
|
| 1711 |
''' Function qui donne la grosseur des maille que l'on aimerait avoir pour
|
| 1712 |
''' </summary>
|
| 1713 |
''' <returns></returns>
|
| 1714 |
''' <remarks></remarks>
|
| 1715 |
Public Function GrosseurMailleFaceInterne() As Double
|
| 1716 |
Dim swEnt As sldworks.Entity
|
| 1717 |
Dim attr As sldworks.Attribute
|
| 1718 |
swEnt = Me.SwFace
|
| 1719 |
attr = swEnt.FindAttribute(Intersections.DefAttrFaceInterne, 0)
|
| 1720 |
If attr Is Nothing Then Return Nothing
|
| 1721 |
Dim p As sldworks.Parameter = attr.GetParameter("FI")
|
| 1722 |
Return p.GetDoubleValue
|
| 1723 |
End Function
|
| 1724 |
|
| 1725 |
''' <summary>
|
| 1726 |
''' Retourne vrai si la face a un attribut de face interne.
|
| 1727 |
''' </summary>
|
| 1728 |
''' <returns></returns>
|
| 1729 |
''' <remarks></remarks>
|
| 1730 |
Public Function PossedeAttributFaceInterne() As Boolean
|
| 1731 |
Dim swEnt As sldworks.Entity
|
| 1732 |
Dim attr As sldworks.Attribute
|
| 1733 |
swEnt = Me.SwFace
|
| 1734 |
attr = swEnt.FindAttribute(Intersections.DefAttrFaceInterne, 0)
|
| 1735 |
If attr Is Nothing Then Return False Else Return True
|
| 1736 |
End Function
|
| 1737 |
|
| 1738 |
|
| 1739 |
''' <summary>
|
| 1740 |
''' Retourne le périmètre de la face
|
| 1741 |
''' </summary>
|
| 1742 |
''' <returns></returns>
|
| 1743 |
''' <remarks>Attention, c'est une approximation!!!</remarks>
|
| 1744 |
Public Function Perimetre() As Double
|
| 1745 |
Dim objArete As Object = Me.SwFace.GetEdges
|
| 1746 |
'Dim swAretes() As sldworks.Edge = objArete
|
| 1747 |
Dim longueur As Double
|
| 1748 |
|
| 1749 |
For Each swArete As sldworks.Edge In objArete
|
| 1750 |
Dim e As New SuperArete(swArete, True)
|
| 1751 |
longueur += e.Longueur()
|
| 1752 |
Next
|
| 1753 |
Return longueur
|
| 1754 |
End Function
|
| 1755 |
|
| 1756 |
|
| 1757 |
''' <summary>
|
| 1758 |
''' Retourne la surface (l'aire) de la face
|
| 1759 |
''' </summary>
|
| 1760 |
''' <returns></returns>
|
| 1761 |
''' <remarks></remarks>
|
| 1762 |
Public Function Aire() As Double
|
| 1763 |
Return Me.SwFace.GetArea
|
| 1764 |
End Function
|
| 1765 |
|
| 1766 |
''' <summary>
|
| 1767 |
''' Retourne le nombre d'arètes contenues dans la superface
|
| 1768 |
''' </summary>
|
| 1769 |
''' <value></value>
|
| 1770 |
''' <returns></returns>
|
| 1771 |
''' <remarks></remarks>
|
| 1772 |
Public ReadOnly Property GetNbAretes() As Integer
|
| 1773 |
Get
|
| 1774 |
Dim nb As Integer
|
| 1775 |
Dim lstFaces() As sldworks.Face2 = Me.SwFace
|
| 1776 |
For Each swFace As sldworks.Face2 In lstFaces
|
| 1777 |
nb += swFace.GetEdgeCount
|
| 1778 |
Next
|
| 1779 |
Return nb
|
| 1780 |
End Get
|
| 1781 |
End Property
|
| 1782 |
|
| 1783 |
Public Function GetSurface() As sldworks.Surface
|
| 1784 |
Return Me.GetFace.GetSurface
|
| 1785 |
End Function
|
| 1786 |
|
| 1787 |
|
| 1788 |
|
| 1789 |
End Class
|
