1 |
Imports SolidWorks.Interop
|
2 |
Imports SolidWorks.Interop.swconst
|
3 |
Imports SolidWorks.Interop.swpublished
|
4 |
|
5 |
''' <summary>
|
6 |
''' La classe de l'arète avec des propriétés et méthodes propres aux poutres
|
7 |
''' </summary>
|
8 |
''' <remarks></remarks>
|
9 |
Public Class SlyAretePoutre
|
10 |
Inherits SuperArete
|
11 |
Public swAttribute As SldWorks.Attribute ' l'attribut qui contient les propriétés de la poutre
|
12 |
|
13 |
Public lst_PtsInterAPAP As New Collection ' une liste des points d'intersections avec d'autres poutres
|
14 |
Public lst_InterCoque As New Collection ' une liste des coques pour intersection coque poutre
|
15 |
Private Shared dossierCree As Boolean ' variable qui optimise le temps de recherche...
|
16 |
Private Shared noInter As Long ' compteur du nombre d'intersection
|
17 |
|
18 |
Private NomSection As String
|
19 |
|
20 |
Private D1 As Double
|
21 |
Private D2 As Double ' de la section
|
22 |
Private D3 As Double
|
23 |
Private D4 As Double
|
24 |
Private D5 As Double
|
25 |
Private D6 As Double
|
26 |
|
27 |
Public X3 As Double = -999999999999
|
28 |
Public Y3 As Double = 123456789
|
29 |
Public Z3 As Double
|
30 |
|
31 |
Private Shared compteur As Long
|
32 |
Private FlagFace_de_section As Double = 99
|
33 |
|
34 |
|
35 |
Sub New(ByVal swarete As SldWorks.Edge)
|
36 |
MyBase.New(swarete, 2)
|
37 |
End Sub
|
38 |
|
39 |
|
40 |
Private Sub MettrePointdeCoupe(ByVal x As Double, ByVal y As Double, ByVal z As Double)
|
41 |
' sub qui met un attribut sur la poutre, l'attribut sera relu par Magic et l'arête sera découpée
|
42 |
|
43 |
Dim Attr As SldWorks.Attribute
|
44 |
Dim nom As String
|
45 |
|
46 |
'MsgBox "X = " & x * 1000 & " Y = " & y * 1000 & " Z = " & z * 1000
|
47 |
nom = "InterAPAP" & CStr(noInter)
|
48 |
Attr = Intersections.DefAttrInterALAL.CreateInstance5(swModel, swArete, nom, 0, SwConst.swInConfigurationOpts_e.swAllConfiguration)
|
49 |
|
50 |
Dim ParamX As SldWorks.Parameter
|
51 |
Dim ParamY As SldWorks.Parameter
|
52 |
Dim ParamZ As SldWorks.Parameter
|
53 |
|
54 |
ParamX = Attr.GetParameter("X")
|
55 |
ParamY = Attr.GetParameter("Y")
|
56 |
ParamZ = Attr.GetParameter("Z")
|
57 |
|
58 |
Dim bRet As Boolean
|
59 |
bRet = ParamX.SetDoubleValue2(x, SwConst.swInConfigurationOpts_e.swAllConfiguration, "")
|
60 |
If bRet = False Then MsgBox("ParamX a pas marché")
|
61 |
Call ParamY.SetDoubleValue2(y, SwConst.swInConfigurationOpts_e.swAllConfiguration, "")
|
62 |
If bRet = False Then MsgBox("ParamY a pas marché")
|
63 |
bRet = ParamZ.SetDoubleValue2(z, SwConst.swInConfigurationOpts_e.swAllConfiguration, "")
|
64 |
If bRet = False Then MsgBox("ParamZ a pas marché")
|
65 |
|
66 |
|
67 |
If Not dossierCree Then
|
68 |
' on commence par vérifier qu'il n'est pas déjà créé
|
69 |
Dim swFeat As SldWorks.Feature
|
70 |
swFeat = swModel.FirstFeature
|
71 |
Do While Not swFeat Is Nothing
|
72 |
If swFeat.GetTypeName = "FtrFolder" And swFeat.Name = "Intersections poutres" Then swPart.ReorderFeature(nom, "Intersections poutres") : dossierCree = True : noInter += 1 : Exit Sub
|
73 |
swFeat = swFeat.GetNextFeature
|
74 |
Loop
|
75 |
|
76 |
swModel.ClearSelection2(True)
|
77 |
swModel.Extension.SelectByID2(nom, "ATTRIBUTE", 0, 0, 0, False, 0, Nothing, 0)
|
78 |
Dim folder As SldWorks.Feature
|
79 |
Dim featMgr As SldWorks.FeatureManager
|
80 |
featMgr = swModel.FeatureManager
|
81 |
folder = featMgr.InsertFeatureTreeFolder2(2)
|
82 |
If Not folder Is Nothing Then folder.Name = "Intersections poutres"
|
83 |
swPart.ReorderFeature(nom, "Intersections poutres")
|
84 |
dossierCree = True
|
85 |
Else
|
86 |
'swModel.Extension.SelectByID2 nom, "ATTRIBUTE", 0, 0, 0, False, 0, Nothing, 0
|
87 |
swPart.ReorderFeature(nom, "Intersections poutres")
|
88 |
End If
|
89 |
|
90 |
noInter += 1
|
91 |
End Sub
|
92 |
|
93 |
Public Sub AjouterPointAPAP(ByVal pt As InterPoutrePoutre)
|
94 |
' sub qui reçoit le point d'intersection et qui l'ajoute à la liste s'il n'est pas déjà créé
|
95 |
pt.CalculT()
|
96 |
|
97 |
Dim p As InterPoutrePoutre
|
98 |
For Each p In lst_PtsInterAPAP
|
99 |
If Math.Abs(p.T - pt.T) < (100 * Epsilon) Then Exit Sub ' on sort de la boucle, innutile de faire une nouvelle coupe
|
100 |
Next p
|
101 |
lst_PtsInterAPAP.Add(pt)
|
102 |
|
103 |
'MettrePointdeCoupe(pt.x, pt.y, pt.z) ' on met la référence (l'attribut)
|
104 |
|
105 |
End Sub
|
106 |
|
107 |
Public Sub EffacerIntersection()
|
108 |
Dim i As Integer
|
109 |
For i = 1 To lst_PtsInterAPAP.Count
|
110 |
lst_PtsInterAPAP.Remove(1)
|
111 |
Next i
|
112 |
End Sub
|
113 |
|
114 |
|
115 |
|
116 |
' sub qui retourne les coordonnées du troisième point de la poutre
|
117 |
Public Function GetPoint3(Optional ByRef NomPoint3 As String = "", Optional ByVal recalculer As Boolean = False) As Double()
|
118 |
|
119 |
Dim temp(2) As Double
|
120 |
|
121 |
If Not Me.X3 = (-999999999999) And (Not Me.Y3 = 123456789) And recalculer = False Then
|
122 |
temp(0) = Me.X3
|
123 |
temp(1) = Me.Y3
|
124 |
temp(2) = Me.Z3
|
125 |
Return temp
|
126 |
End If
|
127 |
|
128 |
temp(0) = 0
|
129 |
temp(1) = 0
|
130 |
temp(2) = 0
|
131 |
|
132 |
Dim swDocExt As SldWorks.ModelDocExtension
|
133 |
Dim swXform As SldWorks.MathTransform
|
134 |
Dim selMgr As SldWorks.SelectionMgr
|
135 |
Dim p As SldWorks.Parameter
|
136 |
|
137 |
Try
|
138 |
p = swAttribute.GetParameter("N3")
|
139 |
|
140 |
swDocExt = swModel.Extension
|
141 |
selMgr = swModel.SelectionManager
|
142 |
NomPoint3 = p.GetStringValue()
|
143 |
swXform = swDocExt.GetCoordinateSystemTransformByName(NomPoint3)
|
144 |
|
145 |
temp(0) = swXform.ArrayData(9)
|
146 |
temp(1) = swXform.ArrayData(10)
|
147 |
temp(2) = swXform.ArrayData(11)
|
148 |
Catch ex As Exception
|
149 |
'y'a pas encore de troisième point attitré
|
150 |
Debug.Write("Impossible de trouver le troisième point, il est pas attitré ou il n'existe pas.")
|
151 |
Me.Colorer(2, 0, 0.5, 0.5)
|
152 |
End Try
|
153 |
|
154 |
Me.X3 = temp(0)
|
155 |
Me.Y3 = temp(1)
|
156 |
Me.Z3 = temp(2)
|
157 |
|
158 |
Return temp
|
159 |
|
160 |
End Function
|
161 |
|
162 |
|
163 |
Public Function GetD1() As Double
|
164 |
If Not D1 = 0 Then Return D1
|
165 |
|
166 |
Dim p As SldWorks.Parameter
|
167 |
Try
|
168 |
p = swAttribute.GetParameter("D1")
|
169 |
Catch ex As Exception
|
170 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir la largeur, la poutre n'a peut-être pas d'attributs...")
|
171 |
Return Nothing
|
172 |
End Try
|
173 |
|
174 |
D1 = p.GetDoubleValue
|
175 |
Return D1
|
176 |
|
177 |
End Function
|
178 |
|
179 |
Public Function GetD2() As Double
|
180 |
If Not D2 = 0 Then Return D2 : Exit Function ' pour optimiser
|
181 |
|
182 |
Dim p As SldWorks.Parameter = Nothing
|
183 |
|
184 |
Try
|
185 |
p = swAttribute.GetParameter("D2")
|
186 |
Catch ex As Exception
|
187 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir la longueur, la poutre n'a peut-être pas d'attributs...")
|
188 |
End Try
|
189 |
|
190 |
D2 = p.GetDoubleValue
|
191 |
Return D2
|
192 |
End Function
|
193 |
|
194 |
Public Function GetD3() As Double
|
195 |
If Not D3 = 0 Then Return D3
|
196 |
|
197 |
Dim p As SldWorks.Parameter = Nothing
|
198 |
Try
|
199 |
p = swAttribute.GetParameter("D3")
|
200 |
Catch ex As Exception
|
201 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir la largeur, la poutre n'a peut-être pas d'attributs...")
|
202 |
End Try
|
203 |
|
204 |
D3 = p.GetDoubleValue
|
205 |
Return D3
|
206 |
End Function
|
207 |
|
208 |
Public Function GetD4() As Double
|
209 |
If Not D4 = 0 Then Return D4
|
210 |
|
211 |
|
212 |
Dim p As SldWorks.Parameter = Nothing
|
213 |
Try
|
214 |
p = swAttribute.GetParameter("D4")
|
215 |
Catch ex As Exception
|
216 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir la largeur, la poutre n'a peut-être pas d'attributs...")
|
217 |
End Try
|
218 |
D4 = p.GetDoubleValue
|
219 |
Return D4
|
220 |
End Function
|
221 |
|
222 |
Public Function GetD5() As Double
|
223 |
If Not D5 = 0 Then Return D5
|
224 |
Dim p As SldWorks.Parameter = Nothing
|
225 |
Try
|
226 |
p = swAttribute.GetParameter("D5")
|
227 |
Catch ex As Exception
|
228 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir la largeur, la poutre n'a peut-être pas d'attributs...")
|
229 |
End Try
|
230 |
D5 = p.GetDoubleValue
|
231 |
Return D5
|
232 |
End Function
|
233 |
|
234 |
Public Function GetD6() As Double
|
235 |
If Not D6 = 0 Then Return D6
|
236 |
Dim p As SldWorks.Parameter = Nothing
|
237 |
Try
|
238 |
p = swAttribute.GetParameter("D6")
|
239 |
Catch ex As Exception
|
240 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir la largeur, la poutre n'a peut-être pas d'attributs...")
|
241 |
End Try
|
242 |
D6 = p.GetDoubleValue
|
243 |
Return D6
|
244 |
End Function
|
245 |
|
246 |
Public Function GetNomSection() As String
|
247 |
If Not NomSection = "" Then Return NomSection
|
248 |
|
249 |
Dim p As SldWorks.Parameter = Nothing
|
250 |
Try
|
251 |
p = swAttribute.GetParameter("S")
|
252 |
Catch ex As Exception
|
253 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir la largeur, la poutre n'a peut-être pas d'attributs...")
|
254 |
End Try
|
255 |
|
256 |
NomSection = p.GetStringValue
|
257 |
Return NomSection
|
258 |
|
259 |
End Function
|
260 |
|
261 |
|
262 |
|
263 |
Public Function GetAireSection() As Double
|
264 |
|
265 |
Dim p As SldWorks.Parameter = Nothing
|
266 |
Try
|
267 |
p = swAttribute.GetParameter("As")
|
268 |
Catch ex As Exception
|
269 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'aire de section, la poutre n'a peut-être pas d'attributs...")
|
270 |
End Try
|
271 |
|
272 |
Return p.GetDoubleValue
|
273 |
|
274 |
End Function
|
275 |
|
276 |
|
277 |
Public Function GetM() As String
|
278 |
|
279 |
Dim p As SldWorks.Parameter = Nothing
|
280 |
Try
|
281 |
p = swAttribute.GetParameter("M")
|
282 |
Catch ex As Exception
|
283 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'aire de section, la poutre n'a peut-être pas d'attributs...")
|
284 |
End Try
|
285 |
|
286 |
Return p.GetStringValue
|
287 |
|
288 |
End Function
|
289 |
|
290 |
Public Function GetAireCarree() As Double
|
291 |
Dim p As SldWorks.Parameter = Nothing
|
292 |
Dim temp As Double
|
293 |
|
294 |
Try
|
295 |
p = swAttribute.GetParameter("D1")
|
296 |
temp = p.GetDoubleValue
|
297 |
p = swAttribute.GetParameter("D2")
|
298 |
Catch ex As Exception
|
299 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'aire de section, la poutre n'a peut-être pas d'attributs...")
|
300 |
End Try
|
301 |
|
302 |
Return p.GetDoubleValue * temp
|
303 |
|
304 |
End Function
|
305 |
|
306 |
|
307 |
Public Function GetInertieXX() As Double
|
308 |
Dim p As SldWorks.Parameter = Nothing
|
309 |
|
310 |
Try
|
311 |
p = swAttribute.GetParameter("I1")
|
312 |
Catch ex As Exception
|
313 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'inertie, la poutre n'a peut-être pas d'attributs...")
|
314 |
End Try
|
315 |
|
316 |
Return p.GetDoubleValue
|
317 |
|
318 |
End Function
|
319 |
|
320 |
Public Function GetInertieYY() As Double
|
321 |
Dim p As SldWorks.Parameter = Nothing
|
322 |
|
323 |
Try
|
324 |
p = swAttribute.GetParameter("I2")
|
325 |
Catch ex As Exception
|
326 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'inertie, la poutre n'a peut-être pas d'attributs...")
|
327 |
End Try
|
328 |
|
329 |
Return p.GetDoubleValue
|
330 |
|
331 |
End Function
|
332 |
|
333 |
Public Function GetSection() As String
|
334 |
Dim p As SldWorks.Parameter = Nothing
|
335 |
|
336 |
Try
|
337 |
p = swAttribute.GetParameter("S")
|
338 |
Catch ex As Exception
|
339 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'inertie, la poutre n'a peut-être pas d'attributs...")
|
340 |
End Try
|
341 |
|
342 |
Return p.GetStringValue
|
343 |
|
344 |
End Function
|
345 |
|
346 |
|
347 |
Public Function GetN3() As String
|
348 |
Dim p As SldWorks.Parameter = Nothing
|
349 |
|
350 |
Try
|
351 |
p = swAttribute.GetParameter("N3")
|
352 |
Catch ex As Exception
|
353 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'inertie, la poutre n'a peut-être pas d'attributs...")
|
354 |
End Try
|
355 |
|
356 |
Return p.GetStringValue
|
357 |
|
358 |
End Function
|
359 |
|
360 |
''' <summary>
|
361 |
''' Créé ou modifie l'attribut des propriétés des poutres.
|
362 |
''' </summary>
|
363 |
''' <param name="miniPoutre">Mettre vrai si on place l'attribut d'une mini-poutre</param>
|
364 |
''' <param name="N3">Le nom du troisième point</param>
|
365 |
''' <param name="M">Le matériau de la poutre</param>
|
366 |
''' <param name="s">Le nom représentant la section de la poutre</param>
|
367 |
''' <param name="As1">L'aire de section</param>
|
368 |
''' <param name="D1">La première dimension</param>
|
369 |
''' <param name="D2"></param>
|
370 |
''' <param name="D3"></param>
|
371 |
''' <param name="D4"></param>
|
372 |
''' <param name="D5"></param>
|
373 |
''' <param name="D6"></param>
|
374 |
''' <param name="Flag">Un flag sur les propriétés des poutres (0 si normal, 1 si FaceInertielle</param>
|
375 |
''' <remarks></remarks>
|
376 |
Public Sub SetAttributsDePoutre(Optional ByRef miniPoutre As Boolean = False, Optional ByRef N3 As String = Nothing, Optional ByRef M As String = Nothing, Optional ByRef s As String = Nothing, Optional ByRef Ixx As Double = -1, Optional ByRef Iyy As Double = -1, Optional ByRef As1 As Double = -1, Optional ByRef D1 As Double = -1, Optional ByRef D2 As Double = -1, Optional ByRef D3 As Double = -1, Optional ByRef D4 As Double = -1, Optional ByRef D5 As Double = -1, Optional ByRef D6 As Double = -1, Optional ByRef Flag As Byte = 0)
|
377 |
Dim nom As String
|
378 |
Dim swArete As SldWorks.Edge
|
379 |
Dim swent As SldWorks.Entity
|
380 |
Dim no As Long
|
381 |
|
382 |
If miniPoutre Then no = Intersections.nbMinipoutre Else no = CLng(Right(N3, Len(N3) - 7))
|
383 |
|
384 |
swArete = Me.swArete
|
385 |
swent = swArete
|
386 |
|
387 |
If miniPoutre Then nom = "MiniPoutre" & CStr(no) Else nom = "RCPoutre" & CStr(no)
|
388 |
Dim Attr As SldWorks.Attribute
|
389 |
|
390 |
Try
|
391 |
Attr = swent.FindAttribute(Intersections.DefAttrRCP1, 0) ' si l'attribut existe déjà on pointe dessus.
|
392 |
Catch ex As Exception
|
393 |
'MsgBox("N'arrive pas à se lier à l'attribut!", MsgBoxStyle.Information, "SetAttributsDePoutre")
|
394 |
Exit Sub
|
395 |
End Try
|
396 |
|
397 |
If Attr Is Nothing Then Attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, swArete, nom, 0, 2) ' 0 = swThisconfig
|
398 |
|
399 |
While Attr Is Nothing
|
400 |
no += 1
|
401 |
compteur += 1
|
402 |
If miniPoutre Then nom = "MiniPoutre" & CStr(no) Else nom = "RCPoutre" & CStr(no)
|
403 |
Attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, swArete, nom, 0, 0)
|
404 |
If no > 100000 Then MsgBox("N'arrive pas à créer l'attribut sur la poutre après 100 000 essais...", MsgBoxStyle.Exclamation, "Problème dans CreationAttributPourPoutre")
|
405 |
|
406 |
End While
|
407 |
|
408 |
Intersections.nbMinipoutre = no ' plus certain que ce soit utile...
|
409 |
|
410 |
Dim swAreteP As SldWorks.Edge
|
411 |
swAreteP = swent
|
412 |
|
413 |
|
414 |
Dim ParamM As SldWorks.Parameter
|
415 |
Dim ParamS As SldWorks.Parameter
|
416 |
Dim ParamI1 As SldWorks.Parameter
|
417 |
Dim ParamI2 As SldWorks.Parameter
|
418 |
Dim ParamD1 As SldWorks.Parameter
|
419 |
Dim ParamD2 As SldWorks.Parameter
|
420 |
Dim ParamD3 As SldWorks.Parameter
|
421 |
Dim ParamD4 As SldWorks.Parameter
|
422 |
Dim ParamD5 As SldWorks.Parameter
|
423 |
Dim ParamD6 As SldWorks.Parameter
|
424 |
Dim ParamAs As SldWorks.Parameter
|
425 |
Dim ParamN3 As SldWorks.Parameter = Nothing
|
426 |
Dim ParamX3 As SldWorks.Parameter
|
427 |
Dim ParamY3 As SldWorks.Parameter
|
428 |
Dim ParamZ3 As SldWorks.Parameter
|
429 |
|
430 |
|
431 |
ParamM = Attr.GetParameter("M")
|
432 |
ParamS = Attr.GetParameter("S")
|
433 |
ParamI1 = Attr.GetParameter("I1")
|
434 |
ParamI2 = Attr.GetParameter("I2")
|
435 |
ParamD1 = Attr.GetParameter("D1")
|
436 |
ParamD2 = Attr.GetParameter("D2")
|
437 |
ParamD3 = Attr.GetParameter("D3")
|
438 |
ParamD4 = Attr.GetParameter("D4")
|
439 |
ParamD5 = Attr.GetParameter("D5")
|
440 |
ParamD6 = Attr.GetParameter("D6")
|
441 |
ParamAs = Attr.GetParameter("As")
|
442 |
ParamX3 = Attr.GetParameter("X3")
|
443 |
ParamY3 = Attr.GetParameter("Y3")
|
444 |
ParamZ3 = Attr.GetParameter("Z3")
|
445 |
|
446 |
If Not miniPoutre Then ParamN3 = Attr.GetParameter("N3")
|
447 |
|
448 |
|
449 |
|
450 |
' maintenant on place les valeurs.
|
451 |
' Paramètre m:
|
452 |
|
453 |
If miniPoutre Then
|
454 |
'mettre ici les valeurs pour les mini-poutres
|
455 |
M = "Materiau"
|
456 |
s = "Section"
|
457 |
Ixx = 22
|
458 |
Iyy = 22
|
459 |
D1 = 22
|
460 |
D2 = 22
|
461 |
As1 = 22
|
462 |
|
463 |
End If
|
464 |
|
465 |
|
466 |
|
467 |
If Not IsNothing(M) Then ParamM.SetStringValue2(M, 2, "") ' swAllConfiguration = 2
|
468 |
If Not IsNothing(s) Then ParamS.SetStringValue2(s, 2, "")
|
469 |
If Not Ixx = -1 Then ParamI1.SetDoubleValue2(Ixx, 2, "")
|
470 |
If Not Iyy = -1 Then ParamI2.SetDoubleValue2(Iyy, 2, "")
|
471 |
If Ixx > Commun.Imax Then Imax = Ixx ' mettre la valeur maximale de IMax pour les mini-poutres infinies...
|
472 |
If Iyy > Commun.Imax Then Imax = Iyy
|
473 |
If Not D1 = -1 Then ParamD1.SetDoubleValue2(D1, 2, "")
|
474 |
If Not D2 = -1 Then ParamD2.SetDoubleValue2(D2, 2, "")
|
475 |
If Not D3 = -1 Then ParamD3.SetDoubleValue2(D3, 2, "")
|
476 |
If Not D4 = -1 Then ParamD4.SetDoubleValue2(D4, 2, "")
|
477 |
If Not D5 = -1 Then ParamD5.SetDoubleValue2(D5, 2, "")
|
478 |
If Not D6 = -1 Then ParamD6.SetDoubleValue2(D6, 2, "")
|
479 |
If Not As1 = -1 Then ParamAs.SetDoubleValue2(As1, 2, "")
|
480 |
If As1 > Commun.Amax Then Commun.Amax = As1
|
481 |
If Not miniPoutre And Not N3 Is Nothing Then
|
482 |
Dim xyz() As Double
|
483 |
ParamN3.SetStringValue2(N3, 2, "")
|
484 |
xyz = Me.GetPoint3(N3, True)
|
485 |
ParamX3.SetDoubleValue2(xyz(0), 2, "")
|
486 |
ParamY3.SetDoubleValue2(xyz(1), 2, "")
|
487 |
ParamZ3.SetDoubleValue2(xyz(2), 2, "")
|
488 |
End If
|
489 |
|
490 |
'swModel.Extension.SelectByID2(nom, "ATTRIBUTE", 0, 0, 0, False, 0, Nothing, 0)
|
491 |
|
492 |
' GererDossiers("Poutres", nom)
|
493 |
|
494 |
If miniPoutre Then swArete.Display(2, 1, 0, 1, True) Else swArete.Display(2, 0, 1, 0, True) ' mini-poutre = violet, poutre = vert
|
495 |
|
496 |
End Sub
|
497 |
|
498 |
Public Sub AddConstantes()
|
499 |
' cette sub ajoute LES constantes de la coque aux nom de l'entité.
|
500 |
' on suppose qu'il n'y en a pas déjà
|
501 |
' tout ce que j'ai à faire c'est de modifier la propriété nom.
|
502 |
|
503 |
'Format(valeur, "0.00000e+000")
|
504 |
|
505 |
' aire section
|
506 |
' inertie XX
|
507 |
' inertieYY
|
508 |
' P3x
|
509 |
' P3y
|
510 |
' P3z
|
511 |
|
512 |
' si on utilise les attributs alors on a pas besoin de ça
|
513 |
|
514 |
' l'ancienne version avec les noms suit.
|
515 |
'Dim aire As Double
|
516 |
'Dim inertieXX As Double
|
517 |
'Dim inertieYY As Double
|
518 |
'Dim pt3(2) As Double
|
519 |
|
520 |
'aire = Me.GetAire
|
521 |
'inertieXX = Me.GetInertieXX
|
522 |
'inertieYY = Me.GetInertieYY
|
523 |
|
524 |
'pt3 = Me.GetPoint3()
|
525 |
|
526 |
'nom = nom & "AS" & Format(aire, "0.00000e+000") & "IX" & Format(inertieXX, "0.00000e+000") & "IY" & Format(inertieYY, "0.00000e+000") & "QX" & Format(pt3(0), "0.00000e+000") & "QY" & Format(pt3(1), "0.00000e+000") & "QZ" & Format(pt3(2), "0.00000e+000")
|
527 |
|
528 |
'' attention, s'il y a une intersection, je dois la noter et l'ajouter au nom....
|
529 |
'Dim inter As InterAPAP
|
530 |
|
531 |
'If Not lst_PtsInterAPAP.Count = 0 Then
|
532 |
' nom = nom & "!" & Format(lst_PtsInterAPAP.Count, "00")
|
533 |
'End If
|
534 |
|
535 |
'For Each inter In lst_PtsInterAPAP
|
536 |
' nom = nom & Math.Sign(inter.x) & Format(Math.Abs(inter.x), "0.00000e+000") & Math.Sign(inter.y) & Format(Math.Abs(inter.y), "0.00000e+000") & Math.Sign(inter.z) & Format(Math.Abs(inter.z), "0.00000e+000")
|
537 |
'Next
|
538 |
|
539 |
'Dim c As Integer
|
540 |
'For c = 1 To Len(nom)
|
541 |
' If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
|
542 |
'Next c
|
543 |
End Sub
|
544 |
|
545 |
Public Function IsFaceDeSection() As Boolean
|
546 |
|
547 |
If Not Me.FlagFace_de_section = 99 Then Return Me.FlagFace_de_section
|
548 |
Dim retour As Double
|
549 |
|
550 |
Dim p As SldWorks.Parameter
|
551 |
Try
|
552 |
p = swAttribute.GetParameter("Flag")
|
553 |
Catch ex As Exception
|
554 |
MsgBox("N'arrive pas à se lier à l'attribut pour obtenir la largeur, la poutre n'a peut-être pas d'attributs...")
|
555 |
Return Nothing
|
556 |
End Try
|
557 |
|
558 |
retour = p.GetDoubleValue
|
559 |
Me.FlagFace_de_section = retour
|
560 |
If retour = 1 Then Return True Else Return False
|
561 |
|
562 |
End Function
|
563 |
|
564 |
|
565 |
''' <summary>
|
566 |
''' Function qui suggère un grosseur de taille pour la poutre en cours.
|
567 |
''' </summary>
|
568 |
''' <returns></returns>
|
569 |
''' <remarks></remarks>
|
570 |
Public Function SuggereGrosseurMaille() As Double
|
571 |
|
572 |
If Left(Me.NomSection, 1) = " " Then ' poutre générique
|
573 |
Select Case Me.NomSection
|
574 |
Case " Rectangle générique"
|
575 |
Return Math.Sqrt(Me.GetD1 ^ 2 + Me.GetD2 ^ 2) / 2
|
576 |
|
577 |
Case " Poutre en I générique"
|
578 |
Return Math.Min(Me.GetD3, Me.GetD4) / 2
|
579 |
|
580 |
Case " Cylindrique (Rod) générique" ' le vrai pipe...
|
581 |
Return Me.GetD1 / 4
|
582 |
|
583 |
Case " Tuyau (Pipe) générique"
|
584 |
Return Me.GetD3 / 2
|
585 |
|
586 |
Case " Tube carré générique"
|
587 |
Return Me.GetD3 / 2
|
588 |
|
589 |
Case " Poutre en C générique"
|
590 |
Return Math.Min(Me.GetD4, Me.GetD3) / 2
|
591 |
|
592 |
Case " Poutre en L générique"
|
593 |
Return Math.Min(Me.GetD3, Me.GetD4) / 2
|
594 |
|
595 |
Case " Poutre en T générique"
|
596 |
Return Math.Min(Me.GetD3, Me.GetD4) / 2
|
597 |
|
598 |
Case Else
|
599 |
MsgBox("Section non reconnue... Break point ici..." & vbCr & Me.NomSection)
|
600 |
End Select
|
601 |
|
602 |
ElseIf Left(Me.NomSection, 2) = "ST" Then
|
603 |
'Sec.nom = "STube 3 x 2.5 x 0.5"
|
604 |
Return Me.GetD3 / 2
|
605 |
|
606 |
ElseIf Left(Me.NomSection, 3) = "Cyl" Then
|
607 |
'sec.nom = "Cylindrique (Rod) 3 "
|
608 |
Return Me.GetD1 / 4
|
609 |
|
610 |
ElseIf Left(Me.NomSection, 1) = "C" Then
|
611 |
'Sec.nom = "C 3 x 4.1"
|
612 |
Return Math.Min(Me.GetD4, Me.GetD3) / 2
|
613 |
|
614 |
ElseIf Left(Me.NomSection, 4) = "Tube" Then
|
615 |
'Sec.nom = "Tube 2 x 0.5"
|
616 |
Return Me.GetD2 / 2
|
617 |
|
618 |
ElseIf Left(Me.NomSection, 1) = "T" Then
|
619 |
'Sec.nom = "T 3 x 2"
|
620 |
Return Math.Min(Me.GetD3, Me.GetD4) / 2
|
621 |
|
622 |
ElseIf Left(Me.NomSection, 1) = "L" Then
|
623 |
'Sec.nom = "LAngle 3 x 3 x.25"
|
624 |
Return Math.Min(Me.GetD3, Me.GetD4) / 2
|
625 |
|
626 |
ElseIf Left(Me.NomSection, 1) = "S" Then
|
627 |
'Sec.nom = "S3 x 5.7"
|
628 |
Return Math.Min(Me.GetD3, Me.GetD4) / 2
|
629 |
|
630 |
Else
|
631 |
MsgBox("Section non reconnue... Break point ici..." & vbCr & Me.NomSection)
|
632 |
|
633 |
End If
|
634 |
|
635 |
End Function
|
636 |
|
637 |
|
638 |
Protected Overrides Sub Finalize()
|
639 |
lst_PtsInterAPAP = Nothing
|
640 |
MyBase.Finalize()
|
641 |
End Sub
|
642 |
|
643 |
|
644 |
|
645 |
End Class
|