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 |
|