ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SlyFaceCoque.vb
Revision: 205
Committed: Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size: 35618 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 SlyFaceCoque
6 Inherits SuperFace
7
8
9 Private epaisseur As Double
10 Public materiau As Long
11 Public swAttribute As SldWorks.Attribute ' l'attribut qui contient l'épaisseur. et le matériau
12
13 Private FlagFace_de_section As Integer = 99
14
15 Sub New(ByRef swface As SldWorks.Face2)
16 MyBase.New(swface, 1) ' 1 car c'est une coque
17 End Sub
18
19 Protected Overrides Sub Finalize()
20 Me.lst_Faces.Clear()
21 Me.lst_InterPoutre.Clear()
22 Me.lst_InterCoqueVolume.Clear()
23 MyBase.Finalize()
24 End Sub
25
26
27 Public Overrides Sub decouper()
28
29 If lst_InterPoutre.Count = 0 Then Exit Sub ' sortir si on a pas d'intersection
30
31
32 ' les attributs ne sont pas updatés sur les faces (mais sur les arètes et les sommets c'est OK)
33 ' on mémorise l'attribut de la face et on la réapplique à la fin.
34
35
36 Dim i As Integer
37 Dim inter As InterPoutreCoque
38 Dim nb1 As Integer, nb2 As Integer, nb3 As Integer, nb5 As Integer
39 Dim poutre1 As SlyAretePoutre = Nothing, poutre3 As SlyAretePoutre = Nothing
40 Dim lst_poutre2 As New Collection
41 Dim aire As Double
42 Dim poutreTest As SlyAretePoutre
43
44 Dim lst_coupeXinter As New Collection
45 Dim lst_coupeXPoutre As New Collection
46 Dim lst_coupeLinter As New Collections.Generic.List(Of InterPoutreCoque)
47 Dim lst_coupeLPoutre As New Collection
48 Dim lst_coupeCinter As New Collection
49 Dim lst_coupeCPoutre As New Collection
50
51
52 For Each inter In lst_InterPoutre
53 'MsgBox("On découpe l'intersection # " & inter.Numero)
54 'pour chaque intersection on peut avoir plusieurs poutres...
55 For i = 1 To inter.lst_sPoutre.Count
56 poutreTest = inter.lst_sPoutre.Item(i)
57 Select Case CInt(inter.lst_type.Item(i))
58 Case 1
59 If poutreTest.GetAireCarree > aire Then poutre1 = poutreTest
60 nb1 += 1
61 Case 2
62 lst_poutre2.Add(poutreTest)
63 nb2 += 1
64 Case 3
65 If poutreTest.GetAireCarree > aire Then poutre3 = poutreTest
66 nb3 += 1
67 Case 5 ' un poutre à faceDeSection
68 nb5 += 1
69 Case 6
70 MsgBox("Une extrémité de la poutre est avec un «Guide» alors que l'autre coté ne l'est pas. Ceci n'est pas programmé...")
71
72 Case 22
73 ' on fait rien, mais c'est pour éviter le msgbox du case else...
74 Case Else
75 MsgBox("Problème dans découper de SlyFaceCoque, le type d'intersection n'est pas reconnu", MsgBoxStyle.Critical)
76 End Select
77 Next i
78
79
80
81 If nb1 > 0 Then 'CoupeX(inter, poutre1) ' on coupe le x en premier
82 lst_coupeXinter.Add(inter)
83 lst_coupeXPoutre.Add(poutre1)
84 End If
85
86
87 For Each poutreTest In lst_poutre2 ' puis on coupe sur la longueur 'CoupeLong(inter, poutreTest)
88 lst_coupeLinter.Add(inter)
89 lst_coupeLPoutre.Add(poutreTest)
90 Next
91
92 If nb3 > 0 Then 'CoupeCote(inter, poutre3) ' finalement on coupe sur les cotés
93 lst_coupeCinter.Add(inter)
94 lst_coupeCPoutre.Add(poutre3)
95 End If
96
97 If nb5 = 1 And (nb1 > 0 Or nb2 > 0 Or nb3 > 0) Then
98 MsgBox("Problème, on a un type d'intersection impossible dans la vraie vie!", MsgBoxStyle.Exclamation, "Design impossible à obtenir en réalité...")
99 End If
100
101
102 lst_poutre2.Clear()
103 nb1 = 0 : nb2 = 0 : nb3 = 0
104
105
106 Next inter
107
108
109 ' maintenant on a toutes les lists d'intersections. On les coupe.
110 For i = 1 To lst_coupeXinter.Count
111 CoupeX(lst_coupeXinter.Item(i), lst_coupeXPoutre.Item(i))
112 Next
113
114 For Each int As InterPoutreCoque In lst_coupeLinter ' i = 1 To lst_coupeLinter.Count
115 int.DecouperLong() 'CoupeLong(lst_coupeLinter.Item(i), lst_coupeLPoutre.Item(i))
116 Next
117
118 For i = 1 To lst_coupeCinter.Count
119 CoupeCote(lst_coupeCinter.Item(i), lst_coupeCPoutre.Item(i))
120 Next
121
122 ' ne devrait pas avoir ça avec une coque...
123 'If nb5 = 1 Then
124 ' If lst_InterPoutre.Count <> 1 Then MsgBox("Plus d'une intersection du type FacedeSection....")
125 ' CoupeFaceDeSection(lst_InterPoutre(1))
126 'End If
127
128 End Sub
129
130
131 ' sub qui découpe les bords de la face.
132 Friend Sub CoupeCote(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre)
133 Dim pt3() As Double, pt3Original() As Double
134 Dim base(2) As Double, baseOriginal(2) As Double
135 Dim swEnt As sldworks.Entity
136 Dim Directionnel As Boolean, Flip As Boolean
137 Dim planReference As sldworks.RefPlane = Nothing
138 Dim sketchline As sldworks.SketchSegment
139 Dim swSketch As sldworks.Sketch
140 Dim DemiLargeur As Double
141 Dim g As Integer
142 Dim Face(1) As sldworks.Face2
143 Dim PlanEntity As sldworks.Entity = Nothing
144 Dim r(2) As Double
145 Dim sk(1) As Double
146 pt3Original = poutre.GetPoint3
147
148
149 swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
150 'swModel.SetAddToDB(True)
151 'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
152
153 Dim vArete As Object
154 Dim cut As Double
155
156 If Me.estPlan Then
157 ' la coque est plane, on met une esquisse dessus.#
158 PlanEntity = Me.SwFace
159 swEnt = PlanEntity
160 swEnt.Select2(False, 0)
161 planReference = swModel.CreatePlaneAtOffset3(0, False, True)
162
163 ElseIf Me.estCylindre Then
164 ' on doit créer un plan de référence...
165
166 ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
167 Dim vEdge As Object
168 Dim i As Integer
169 Dim swArete2() As sldworks.Edge
170 Dim swSommet As sldworks.Vertex
171
172 vEdge = Me.SwFace.GetEdges
173 swArete2 = vEdge
174 swModel.ClearSelection2(True)
175
176 While planReference Is Nothing
177 If UBound(swArete2) - 2 < i Then MsgBox("Dans CoupeLong, problème pour créer un plan avec 3 points. (La face est un FauxPlan)", MsgBoxStyle.Critical, "Le plan ne sera pas créé") : Exit While
178 swSommet = swArete2(i).GetStartVertex()
179 swEnt = swSommet
180 swEnt.Select4(False, Nothing)
181 swArete2(i + 1).GetStartVertex()
182 swEnt = swSommet
183 swEnt.Select4(True, Nothing)
184 swArete2(i + 2).GetStartVertex()
185 swEnt = swSommet
186 swEnt.Select4(True, Nothing)
187 i += 1
188 planReference = swModel.CreatePlaneThru3Points3(False)
189 PlanEntity = planReference
190 End While
191
192
193 Else ' la face est une spline
194 MsgBox("Dans coupeCoté, la face est un type de surface qui n'est pas encore traité")
195 End If
196
197
198 baseOriginal(0) = inter.x : baseOriginal(1) = inter.y : baseOriginal(2) = inter.z
199
200
201 Dim Psi As Double
202 Dim u(2) As Double, v(2) As Double, usketch(2) As Double, vsketch(2) As Double
203 Dim Arete As sldworks.Edge = Nothing
204 Dim retval As Object
205 u = poutre.GetOrientation(inter.x, inter.y, inter.z)
206
207
208 vArete = Me.SwFace.GetEdges
209
210 For Each Arete In vArete
211 If Commun.Distance(Arete, inter.x, inter.y, inter.z) < Epsilon Then Exit For
212 Next
213
214 retval = Arete.GetClosestPointOn(inter.x, inter.y, inter.z)
215 Dim t As Double = retval(3)
216 retval = Arete.Evaluate(t)
217
218 If t > 0 Then ' ??????? solidworks inverse les valeurs dans des cas que je ne peut identifier.
219 v(0) = retval(3) : v(1) = retval(4) : v(2) = retval(5)
220 Else
221 v(0) = retval(4) : v(1) = -retval(3) : v(2) = retval(5)
222 End If
223
224
225
226 For g = 0 To 1
227
228 PlanEntity.Select(False)
229 swModel.InsertSketch2(True)
230 swSketch = swModel.GetActiveSketch2
231
232 pt3 = Commun.TransfertModelSketch(swSketch, pt3Original)
233 usketch = Commun.TransfertModelSketch(swSketch, u) ' on les met dans le plan du sketch
234 vsketch = Commun.TransfertModelSketch(swSketch, v)
235 base = Commun.TransfertModelSketch(swSketch, baseOriginal)
236 Psi = Outils_Math.cosdir(usketch, vsketch)
237
238 Dim a As Double, b As Double
239 'longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
240 'If pt3(1) = 0 Then a = 999999999999 Else a = Math.Abs(poutre.GetD2() * longueur / pt3(1))
241 'If pt3(0) = 0 Then b = 999999999999 Else b = Math.Abs(poutre.GetD1() * longueur / pt3(0))
242 ' À revoir. Si le plan est un cylindre ça marche plus. sans compter l'épaisseur de la poutre.
243 ' pour l'instant je prend la plus prtite valeur...
244 a = poutre.GetD1
245 b = poutre.GetD2
246 DemiLargeur = Math.Min(a, b)
247 cut = DemiLargeur / Math.Sin(Pi / 2 - Psi)
248
249
250 Dim P1(1) As Double
251 Dim P2(1) As Double
252 Dim P3(1) As Double
253 Dim P4(1) As Double
254 Dim Ptest(2) As Double
255 Dim Ptest2(2) As Double : Ptest2(0) = 0.5 : Ptest2(1) = 0
256 Dim Ptest3(2) As Double : Ptest3(0) = 0 : Ptest3(1) = 0.75
257 Dim Ptest4(2) As Double : Ptest4(0) = 1.5 : Ptest4(1) = 0
258 Dim Ptest5(2) As Double : Ptest5(0) = 0 : Ptest5(1) = 2
259
260
261 If g = 0 Then
262 P1(0) = -cut
263 P1(1) = -cut '* mult ' 0
264 P2(0) = 0
265 P2(1) = -cut '* mult ' 0
266 P3(0) = 0
267 P3(1) = cut 'Intersections.Taille mult
268 P4(0) = -cut
269 P4(1) = cut 'Intersections.Taille mult
270 'sk(0) = -Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
271 sk(0) = -Epsilon * 100 : sk(1) = 0
272
273 Else
274 P1(0) = 0
275 P1(1) = -cut '* mult '0
276 P2(0) = +cut
277 P2(1) = -cut '* mult '0
278 P3(0) = +cut
279 P3(1) = cut 'Intersections.Taille mult
280 P4(0) = 0
281 P4(1) = cut 'Intersections.Taille mult
282 'sk(0) = Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
283 sk(0) = Epsilon * 100 : sk(1) = 0
284 End If
285
286 P1 = Outils_Math.Rotation2D(vsketch, P1)
287 P2 = Outils_Math.Rotation2D(vsketch, P2)
288 P3 = Outils_Math.Rotation2D(vsketch, P3)
289 P4 = Outils_Math.Rotation2D(vsketch, P4)
290 sk = Outils_Math.Rotation2D(vsketch, sk)
291 Ptest4 = Outils_Math.Rotation2D(vsketch, Ptest4)
292 Ptest5 = Outils_Math.Rotation2D(vsketch, Ptest5)
293
294 sk(0) += base(0)
295 sk(1) += base(1)
296
297 Ptest(0) += base(0)
298 Ptest(1) += base(1)
299
300 swModel.CreatePoint2(Ptest(0), Ptest(1), 0)
301
302 sketchline = swModel.CreateLine2(base(0), base(1), 0, Ptest2(0) + base(0), Ptest2(1) + base(1), 0) : sketchline.ConstructionGeometry = True
303 sketchline = swModel.CreateLine2(base(0), base(1), 0, Ptest3(0) + base(0), Ptest3(1) + base(1), 0) : sketchline.ConstructionGeometry = True
304 sketchline = swModel.CreateLine2(base(0), base(1), 0, Ptest4(0) + base(0), Ptest4(1) + base(1), 0) : sketchline.ConstructionGeometry = True
305 sketchline = swModel.CreateLine2(base(0), base(1), 0, Ptest5(0) + base(0), Ptest5(1) + base(1), 0) : sketchline.ConstructionGeometry = True
306 sketchline = swModel.CreateLine2(base(0), base(1), 0, vsketch(0) + base(0), vsketch(1) + base(1), 0) : sketchline.ConstructionGeometry = True
307
308 sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P2(0) + base(0), P2(1) + base(1), 0)
309 sketchline = swModel.CreateLine2(P2(0) + base(0), P2(1) + base(1), 0, P3(0) + base(0), P3(1) + base(1), 0)
310 sketchline = swModel.CreateLine2(P3(0) + base(0), P3(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
311 sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
312
313
314
315 swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
316 swModel.ClearSelection2(True)
317 'swEnt = Me.SwFace : swEnt.Select2(False, 1)
318 swEnt = swSketch : swEnt.Select2(False, 4)
319 Me.SelectionnerToutes(1, True)
320
321 swModel.InsertSplitLineProject(Directionnel, Flip)
322 r = Commun.TransfertSketchToModel(swSketch, sk)
323 Face(g) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, , False)
324 'If Face(g) Is Nothing Then
325 'swSketch.Select(False)
326 'swModel.EditDelete()
327 'End If
328
329
330 Next g
331
332
333
334 ' mettre les mini-poutres
335 Dim vEdge2 As Object
336 Dim swArete As sldworks.Edge
337 Dim vPoint As Object
338 Dim Mini1 As sldworks.Edge = Nothing, Mini2 As sldworks.Edge = Nothing
339
340
341 ' 1 - trouver les 2 arrères dont l'orientation est la même (ou l'inverse) que le v
342 For g = 0 To 1
343 If Not Face(g) Is Nothing Then
344 vEdge2 = Face(g).GetEdges()
345
346
347 ' construire u
348 For Each swArete In vEdge2
349 If Commun.Distance(swArete, inter.x, inter.y, inter.z) < Epsilon Then
350 ' l'arête touche à l'intersection,
351 vPoint = swArete.GetClosestPointOn(inter.x, inter.y, inter.z)
352 vPoint = swArete.Evaluate(vPoint(3))
353 u(0) = vPoint(3) : u(1) = vPoint(4) : u(2) = vPoint(5)
354
355 If Outils_Math.CompareSens(v, u) Then
356 ' l'arète doit être une mini-poutre
357 If Mini1 Is Nothing Then Mini1 = swArete : Exit For Else Mini2 = swArete : Exit For
358 End If
359 End If
360
361 Next
362
363 End If
364 Next
365
366 swEnt = Mini1
367 If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
368
369 If Not Mini2 Is Nothing Then
370 swEnt = Mini2
371 If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
372 End If
373
374 swModel.SetInferenceMode(True) '
375 'swModel.SetAddToDB(False)
376 'swModel.SetDisplayWhenAdded(True) '
377 End Sub
378
379
380
381 ''' <summary>
382 ''' sub qui CRÉÉ une instance de la classe InterPoutreCoque si et seulement si il n'en existe pas avant. S'il en existe alors on update la classe déjà existante.
383 ''' </summary>
384 ''' <param name="sPoutre">La SlyPoutre</param>
385 ''' <param name="xyz1">Laposition du pount d'intersection</param>
386 ''' <param name="tipe">=1 si on découpe en X, 2 si à l'intérieur, 3 si à l'extérieur</param>
387 ''' <returns>La classe d'intersection</returns>
388 ''' <remarks>dans tous les cas on retourne la classe (pour pouvoir l'ajouter à la poutre...)</remarks>
389 Public Function AjouterInterPoutre(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterPoutreCoque
390
391 Dim int As InterPoutreCoque
392
393 For Each int In lst_InterPoutre
394 If Math.Abs(int.x - xyz1(0)) < Epsilon And Math.Abs(int.y - xyz1(1)) < Epsilon And Math.Abs(int.z - xyz1(2)) < Epsilon Then
395 ' on a un point déjà existant,
396 int.lst_sPoutre.Add(sPoutre)
397 int.lst_type.Add(tipe)
398 Return int
399 End If
400 Next
401
402
403 ' si on est ici c'est que l'on doit créer l'intersection
404 int = New InterPoutreCoque
405
406 int.x = xyz1(0)
407 int.y = xyz1(1)
408 int.z = xyz1(2)
409
410 int.lst_sPoutre.Add(sPoutre)
411 int.lst_type.Add(tipe)
412 int.sFaceCoque = Me
413 lst_InterPoutre.Add(int)
414 Return int
415
416 End Function
417
418
419
420
421 Public Function PossedeFaceDeSection() As Boolean
422
423 If Not Me.FlagFace_de_section = 99 Then Return CBool(Me.FlagFace_de_section)
424 Dim retour As Double
425
426 Dim p As SldWorks.Parameter
427 Try
428 p = swAttribute.GetParameter("Flag")
429 Catch ex As Exception
430 MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'épaissuer, la coque n'a peut-être pas d'attributs...")
431 Return Nothing
432 End Try
433
434 retour = p.GetDoubleValue
435 Me.FlagFace_de_section = retour
436 If retour = 1 Then Return True Else Return False
437
438 End Function
439
440
441 ''' <summary>
442 ''' Donne l'épaisseur de la coque
443 ''' </summary>
444 ''' <value>La valeur de l'épaisseur ATTENTION: voir remarques</value>
445 ''' <returns>L'épaisseur de la coque</returns>
446 ''' <remarks>La propriété ne peut être un readonly à cause d'une petite exception, normalement on ne devrait pas setter l'épaisseur de la coque</remarks>
447 Public Property GetEpaisseur() As Double
448 Get
449
450 If Not Me.epaisseur = 0 Then Return Me.epaisseur : Exit Property ' pour optimiser
451
452 Dim p As sldworks.Parameter
453
454 Try
455 p = swAttribute.GetParameter("Ep")
456 Catch ex As Exception
457 MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'épaisseur, la coque n'a peut-être pas d'attributs...")
458 Return 0
459 End Try
460 Me.epaisseur = p.GetDoubleValue
461 Return p.GetDoubleValue
462
463 End Get
464
465 Set(ByVal value As Double)
466 Me.epaisseur = value
467 ' faut aussi changer le paramètre de l'attribut
468 Dim p As sldworks.Parameter = Me.swAttribute.GetParameter("Ep")
469 p.SetDoubleValue(Me.epaisseur)
470 End Set
471 End Property
472
473
474
475 Public Function GetMateriau() As String
476 If Not Me.materiau Then Return Me.materiau : Exit Function ' pour optimiser
477
478
479 Dim p As SldWorks.Parameter = Nothing
480
481 Try
482 p = swAttribute.GetParameter("M")
483 Catch ex As Exception
484 MsgBox("N'arrive pas à se lier à l'attribut pour obtenir le matériau, la coque n'a peut-être pas d'attributs...")
485 End Try
486 Me.materiau = p.GetStringValue
487 Return p.GetStringValue
488 End Function
489
490 Public Function GetAttribute() As SldWorks.Attribute
491 Dim ent As SldWorks.Entity
492 Dim attr As SldWorks.Attribute = Nothing
493
494 Try
495 ent = lst_Faces.Item(1)
496 attr = ent.FindAttribute(Intersections.DefAttrRCCoque, 0)
497 Me.swAttribute = attr
498 Catch ex As Exception
499 MsgBox("ERREUR! Une coque sans attributs !", MsgBoxStyle.Critical)
500 End Try
501 If IsNothing(attr) Then ' on a trouvé un attribut de coque
502 MsgBox("Une coque sans attributs !")
503 End If
504 Return attr
505 End Function
506
507 Private Function PointInterne(ByRef P1() As Double, ByRef P2() As Double, ByRef centreX As Double, ByRef centreY As Double) As Double()
508 Dim b(1) As Double
509 Dim c(1) As Double
510 Dim d(1) As Double
511 b(0) = P1(0) - centreX
512 b(1) = P1(1) - centreY
513 c(0) = P1(0) - centreX
514 c(1) = P1(1) - centreY
515
516 b = Outils_Math.unitaire(b)
517 c = Outils_Math.unitaire(c)
518
519 d(0) = ((b(0) + c(0)) / 2) * 50 * Epsilon
520 d(1) = ((b(0) + c(0)) / 2) * 50 * Epsilon
521
522 Return d
523
524 End Function
525
526 ' cette sub ajoute LES constantes de la coque aux nom de l'entité.
527 Public Sub AddConstantes()
528 ' cette sub ajoute LES constantes de la coque aux nom de l'entité.
529 ' on suppose qu'il n'y en a pas déjà
530 ' tout ce que j'ai à faire c'est de modifier la propriété nom.
531
532 'Format(valeur, "0.00000e+000")
533 Dim epaisseur As Double
534
535
536 epaisseur = Me.GetEpaisseur()
537 If epaisseur <= 0 Then
538 MsgBox("Attention, une coque n'a pas d'épaisseur ou une épaisseur négative, celle-ci est affichée en rouge sur le modèle découpé. Une valeur de 1 a été utilisée par défaut")
539 epaisseur = 1
540 Dim ent As SldWorks.Entity
541 ent = Me.swFace : ent.Select4(False, Nothing)
542 swModel.SelectedFaceProperties(1, 0, 0, 0, 0, 0, 0, False, "")
543 End If
544
545
546 nom = nom & "¢" & Format(epaisseur, "0.00000e+000") & "MA" & Format(materiau, "00")
547
548 ' attention, s'il y a une intersection, je dois la noter et l'ajouter au nom....
549 Dim c As Integer
550 For c = 1 To Len(nom)
551 If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
552 Next c
553 End Sub
554
555
556
557 Protected 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, Optional ByVal ajouterMini As Boolean = False) As sldworks.Face2
558
559 ' le pointeur Me.swFace pointe soit sur une face, soit sur la face originale soit la face découpée
560 ' cette procédure doit créer une nouvelle SlyFaceCoque
561 ' et tout ce que j'ai c'est un pointeur, et je sais même pas lequel.
562 ' la fonction ne créée pas de nouvelles slyEntités.
563 ' si le découpage donne 3 faces ou plus, elles sont placées dans lst_AutreFaces
564
565
566 ' 1 - on obtient les 2 nouvelles faces,
567 Dim vFace As Object
568 Dim Face As sldworks.Face2 = Nothing
569 Dim FaceInterne As sldworks.Face2
570 Dim swFeat As sldworks.Feature
571 Dim swent As sldworks.Entity = Nothing
572 Dim swFaultEnt As sldworks.FaultEntity
573
574 swFeat = swModel.FeatureByPositionReverse(0)
575 Try
576 vFace = swFeat.GetFaces
577 For Each Face In vFace
578 Me.lst_Faces.Add(Face)
579 Next Face
580 Catch
581 ' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
582 ' on doit donc le déterminer anyway
583 End Try
584
585
586
587 For Each Face In Me.lst_Faces ' à revoir
588 swFaultEnt = Face.Check
589 If Not IsNothing(swFaultEnt) Then
590 Me.lst_Faces.GetEnumerator()
591 End If
592 Next Face
593
594
595 ' on créé un point dans un sketch et on le place
596 ' This method projects the selected sketch items from the current sketch on a selected surface.
597 ' en fait ça projette juste une courbe...
598 ' et si ça retourne nul alors la projection a pas marchée.
599 Dim swSKSeg As sldworks.SketchSegment
600 swSKSeg = Commun.MettreUneLigne(Plan, x - 20 * Epsilon, y - 20 * Epsilon, z, x + 20 * Epsilon, y + 20 * Epsilon, z)
601
602 swFeat = Nothing
603 For Each Face In Me.lst_Faces
604 swSKSeg.Select4(False, Nothing)
605 swent = Face : swent.Select4(True, Nothing)
606 swFeat = swModel.InsertProjectedSketch2(0) ' 1 pour inverser la direction de la projection
607 If swFeat IsNot Nothing Then Exit For
608 swFeat = swModel.InsertProjectedSketch2(1) ' 1 pour inverser la direction de la projection
609 If swFeat IsNot Nothing Then Exit For
610 Next Face
611
612
613 If swFeat Is Nothing Then
614 ' on passe à un autre type d'essai...
615 Dim dist As Double
616 For Each Face In Me.lst_Faces
617 dist = swModel.ClosestDistance(Face, swSKSeg, Nothing, Nothing)
618 If Math.Abs(dist) < Epsilon Then FaceInterne = Face : Exit For
619 Next Face
620
621
622 If FaceInterne Is Nothing Then MsgBox("N'a pas réussi à trouver la bonne face dans le UpdateAPrèsSplit")
623 Return Nothing
624
625
626 Else
627 FaceInterne = Face
628 ' effacer le feature...
629 End If
630
631
632 ' ************************************************
633 ' pour placer un attribut sur la face interne
634 Static no As Integer
635
636 If FI Then no = Me.MettreAttributFaceInterne(FaceInterne, poutre.SuggereGrosseurMaille, True)
637 If ajouterMini Then MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
638
639
640 'If FI Then
641 ' Dim nom2 As String = "FaceInterne" & no
642
643 ' swent = FaceInterne
644 ' attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
645
646 ' If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
647
648 ' While attr Is Nothing
649 ' no += 1
650 ' nom2 = "FaceInterne" & CStr(no)
651 ' attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
652 ' End While
653 ' GererDossiers("FaceInternes", nom2)
654 ' no += 1
655 'ElseIf Flag = 2 Then ' on a un channel, on fait les 2 options
656 ' Dim nom2 As String = "FaceInterne" & no
657
658 ' swent = FaceInterne
659 ' attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
660
661 ' If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
662
663 ' While attr Is Nothing
664 ' no += 1
665 ' nom2 = "FaceInterne" & CStr(no)
666 ' attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
667 ' End While
668 ' GererDossiers("FaceInternes", nom2)
669 ' no += 1
670 ' MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
671 'Else
672 ' If Not VientDeCoupecote Then MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
673 'End If
674
675 ' ************ l'attribut de la condition aux limites *******************
676 Dim attr As sldworks.Attribute
677 attr = Nothing
678 Dim nom3 As String
679 Dim p As sldworks.Parameter
680 If Not Me.condition = "" Then
681 nom3 = "CLc_" & no & "_" & Me.nom & " " & Me.condition
682 attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
683
684 While attr Is Nothing
685 If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, FaceInterne, nom3, 0, 0)
686 If attr Is Nothing Then nom3 = nom3 & CStr(Timer)
687 End While
688
689 p = attr.GetParameter("CL")
690 p.SetStringValue(Me.condition)
691
692 End If
693 GererDossiers("Conditions Aux Limites", nom3)
694 ' *****************************************************
695 Return FaceInterne
696
697
698 End Function
699
700 Public Sub SetAttributDeCoque(ByRef epaisseur As Double, Optional ByRef materiau As String = Nothing)
701 Dim nom As String
702 Dim swFace As SldWorks.Face2
703 Dim swent As SldWorks.Entity
704 Dim no As Long
705 Dim Attr As SldWorks.Attribute
706
707 swFace = Me.SwFace
708 swent = swFace
709
710
711 Try
712 Attr = swent.FindAttribute(Intersections.DefAttrRCCoque, 0) ' si l'attribut existe déjà on pointe dessus.
713 Catch ex As Exception
714 'MsgBox("N'arrive pas à se lier à l'attribut!", MsgBoxStyle.Information, "SetAttributsDePoutre")
715 Exit Sub
716 End Try
717
718 If Attr Is Nothing Then Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 2) ' 0 = swThisconfig
719
720 While Attr Is Nothing
721 no += 1
722 nom = "RCCoque" & CStr(no)
723 Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 0)
724 If no > 100000 Then MsgBox("N'arrive pas à créer l'attribut sur la coque après 100 000 essais...", MsgBoxStyle.Exclamation, "Problème dans CreationAttributPourPoutre")
725
726 End While
727
728
729 Dim ParamM As SldWorks.Parameter
730 Dim ParamEp As SldWorks.Parameter
731
732 ParamM = Attr.GetParameter("M")
733 ParamEp = Attr.GetParameter("Ep")
734
735 If materiau IsNot Nothing Then ParamM.SetStringValue2(materiau, 2, "") ' swAllConfiguration = 2
736 ParamEp.SetStringValue2(epaisseur, 2, "")
737
738 End Sub
739
740
741 Protected Sub CoupeX(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre)
742 Dim swEnt As sldworks.Entity = Nothing
743 Dim Directionnel As Boolean, Flip As Boolean
744 Dim Faces(3) As sldworks.Face2
745 Dim r(2) As Double
746 Dim LaSurface As sldworks.Surface
747 Dim sens As Boolean
748 Dim p(2) As Double
749 Dim retour() As Double
750
751 'swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
752 'swModel.SetAddToDB(True)
753 'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
754
755
756 ' l'idée est de sélectionner le point et l'arète puis d'utiliser CreatePlanePerCurveAndPassPoint3
757 Dim planReference As sldworks.RefPlane
758 Dim swsketch As sldworks.Sketch
759 Dim swSommet As sldworks.Vertex, swSommet2 As sldworks.Vertex
760 Dim pointdeb(2) As Double, pointfin(2) As Double
761
762 'swModel.Extension.SelectByID2("", "POINTREF", inter.x, inter.y, inter.z, False, 0, Nothing, 0)
763 ' faut vraiment sélectionner le bon point...
764 swSommet = poutre.swArete.GetStartVertex()
765 swSommet2 = poutre.swArete.GetEndVertex()
766 If swSommet Is Nothing Then
767 MsgBox("On a un cercle ou courbe sans sommets, dans coupeX, pas encore traité. Ne peut pas mettre un plan si pas de sommet")
768 Else
769 If Distance(swSommet, inter.x, inter.y, inter.z) < Epsilon Then
770 swEnt = swSommet
771 ElseIf Distance(swSommet2, inter.x, inter.y, inter.z) < Epsilon Then
772 swEnt = swSommet2
773 Else
774 MsgBox("Dans coupeX, l'intersection n'est pas sur un sommet. Pas encore traité. Nécessite de créer un point au coordonnées d'intersection")
775 End If
776 End If
777
778 swEnt.Select4(False, Nothing)
779 swEnt = poutre.swArete
780 swEnt.Select(True)
781
782 If Me.estPlan Or Me.estFauxPlan(inter.x, inter.y, inter.z) Then
783 ' si la coque est plane alors on projette le plan de référence des deux cotés, sinon on doit le décaler vers le bas
784 planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
785 Directionnel = False
786 Flip = False
787 ElseIf Me.estCylindre Then
788 ' on a un cylindre, on ne projette pas des 2 cotés. On créé un plan, puis un autre plus bas pour ensuite projeter d'un seul coté.
789 Dim PlanDessus As sldworks.RefPlane
790 Dim Rayon As Double, L As Double, B As Double, phi As Double, dist As Double, temp1 As Double, temp2 As Double
791 Dim u(2) As Double, v(2) As Double
792 PlanDessus = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
793 temp1 = poutre.GetD1
794 temp2 = poutre.GetD2
795 L = Math.Sqrt(temp1 * temp1 + temp2 * temp2)
796 Rayon = Me.GetRayonCylindre()
797 u = poutre.GetOrientation(inter.x, inter.y, inter.z)
798 v = Me.GetNormale(inter.x, inter.y, inter.z)
799 phi = -(Math.Acos(Outils_Math.cosdir(u, v)))
800 B = Math.Abs(L / 2 * Math.Sin(phi))
801 dist = Rayon - Math.Sqrt(Rayon * Rayon - ((L / 2) * (L / 2))) + B
802 If dist < 0 Then MsgBox("Gros problème pour couper le cylindre, la poutre est plus grosse!!!!!!", MsgBoxStyle.Critical) : Exit Sub
803
804 swEnt = PlanDessus
805 swEnt.Select(False)
806 Directionnel = True
807
808 Flip = Flipper(PlanDessus, inter)
809
810 planReference = swModel.CreatePlaneAtOffset3(dist * 2, Flip, True)
811 Else
812 MsgBox("La coque n'est ni un cylindre, ni un plan" & vbCr & "Le résultat n'est pas certain...", MsgBoxStyle.Information, "Avertissement")
813 planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
814 Directionnel = False
815 Flip = False
816 End If
817
818
819
820 LaSurface = Me.SwFace.GetSurface()
821 sens = Me.SwFace.FaceInSurfaceSense()
822
823 ' skx est la coordonnée du point de ref en coord de sketch, Rx est le point de référence dans le repère global.
824 Dim i As Integer = 0, MettreFI As Boolean
825 Dim swFeat As sldworks.Feature
826 Dim autresection As Boolean = True
827 Dim AjouterMiniPoutre As Boolean = False
828
829 Do While autresection = True
830 i += 1
831 swEnt = planReference
832 swEnt.Select(False)
833 swModel.InsertSketch2(False)
834 swModel.ClearSelection2(True)
835 swFeat = swModel.FeatureByPositionReverse(0)
836 swModel.SelectByID(swFeat.Name, "SKETCH", 0, 0, 0)
837 swModel.EditSketch()
838 swsketch = swModel.GetActiveSketch2
839
840 p(0) = inter.x : p(1) = inter.y : p(2) = inter.z
841 retour = Commun.TransfertModelSketch(swsketch, p)
842
843
844 If SectionSimpleSurPoutre = True Then
845 r = DessineSectionPoutreSimple(poutre, retour(0), retour(1), i, swsketch, CType(inter, InterAreteFace), MettreFI, autresection, AjouterMiniPoutre)
846 Else
847 r = DessineSectionPoutre(poutre, retour(0), retour(1), i, swsketch, CType(inter, InterAreteFace), MettreFI, autresection, AjouterMiniPoutre)
848 End If
849
850
851
852 swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
853 swModel.ClearSelection2(True)
854
855 Dim face As sldworks.Face2
856 For Each face In Me.lst_Faces
857 swModel.ClearSelection2(True)
858 swEnt = face : swEnt.Select2(False, 1)
859 swEnt = swsketch : swEnt.Select2(True, 4)
860 swModel.InsertSplitLineProject(Directionnel, Flip)
861 Next
862
863
864 Me.SwFace.DetachSurface()
865 Me.SwFace.AttachSurface(LaSurface, sens)
866
867 Faces(i) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, MettreFI, AjouterMiniPoutre)
868 Commun.MettreUnPoint(r(0), r(1), r(2))
869
870 If Faces(i) Is Nothing Then
871 swEnt.Select(False)
872 swModel.EditDelete()
873 End If
874 Loop
875
876
877 End Sub
878
879
880 End Class
881