ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SuperFace.vb
Revision: 205
Committed: Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size: 91614 byte(s)
Log Message:
Commit de MAGiC_SLD pendant que j'y pense.  Les modifications ne devraient pas concerner personne d'autre que moi.   -- Sylvain

File Contents

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