ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/RCCode.vb
Revision: 40
Committed: Mon Aug 20 21:30:28 2007 UTC (17 years, 8 months ago) by bournival
File size: 46842 byte(s)
Log Message:
Projet de these de Sylvain Bournival. Attention projet VB.

File Contents

# Content
1 Imports SwConst
2
3 Namespace RealConstant
4 Module RCCode
5
6
7 Public GroupPoutre As SldWorks.PropertyManagerPageGroup
8 Public GroupCoque As SldWorks.PropertyManagerPageGroup
9 Public RCCheckFacedeSection As SldWorks.PropertyManagerPageCheckbox
10 Public RCCheckFacedeSectionCoque As SldWorks.PropertyManagerPageCheckbox
11 Public RCcombo1 As SldWorks.PropertyManagerPageCombobox ' matériau poutre
12 Public RCcombo2 As SldWorks.PropertyManagerPageCombobox ' section poutre
13 Public RCcombo3 As SldWorks.PropertyManagerPageCombobox ' matériau coque
14 Public RCselection1 As SldWorks.PropertyManagerPageSelectionbox ' les poutres
15 Public RCselection2 As SldWorks.PropertyManagerPageSelectionbox ' le troisième point
16 Public RCselection3 As SldWorks.PropertyManagerPageSelectionbox ' les coques
17 Public RCNumberbox1 As SldWorks.PropertyManagerPageNumberbox ' I1
18 Public RCNumberbox2 As SldWorks.PropertyManagerPageNumberbox ' I2
19 Public RCNumberboxD1 As SldWorks.PropertyManagerPageNumberbox
20 Public RCNumberboxD2 As SldWorks.PropertyManagerPageNumberbox
21 Public RCNumberboxD3 As SldWorks.PropertyManagerPageNumberbox
22 Public RCNumberboxD4 As SldWorks.PropertyManagerPageNumberbox
23 Public RCNumberboxD5 As SldWorks.PropertyManagerPageNumberbox
24 Public RCNumberboxD6 As SldWorks.PropertyManagerPageNumberbox
25 Public RCNumberbox5 As SldWorks.PropertyManagerPageNumberbox
26 Public RCNumberbox6 As SldWorks.PropertyManagerPageNumberbox ' épaisseur de la coque
27
28 Public LabelD1 As SldWorks.PropertyManagerPageLabel
29 Public LabelD2 As SldWorks.PropertyManagerPageLabel
30 Public LabelD3 As SldWorks.PropertyManagerPageLabel
31 Public LabelD4 As SldWorks.PropertyManagerPageLabel
32 Public LabelD5 As SldWorks.PropertyManagerPageLabel
33 Public LabelD6 As SldWorks.PropertyManagerPageLabel
34
35 Private lst_Section As New Collection ' liste des sections de poutres
36
37 Private compteur As Long
38
39 Private Structure materiau
40 Dim nom As String
41 Dim E As Double
42 Dim sigmay As Double
43 Dim poisson As Double
44 End Structure
45
46
47 Public Function debut() As Boolean
48 RegisterAttribut()
49 If GroupPoutre.Checked = True Then
50 If Not GestionAttributPoutre() Then debut = False
51 End If
52 If GroupCoque.Checked = True Then
53 If Not GestionAttributCoque() Then debut = False : Exit Function
54 End If
55 If GroupPoutre.Checked = False And GroupCoque.chexked = False Then MsgBox("Vous devez cocher les options que vous désirez avoir, les poutres, les coques ou les deux" & Chr(13) & "Aucune valeurs mémorisées", MsgBoxStyle.Critical, "Aucun groupe choisit")
56
57 End Function
58
59
60
61
62 Private Function GestionAttributPoutre() As Boolean
63 ' sub qui vient lire les infos de la page des RC
64
65 Dim obj As Object
66 Dim swArete As SldWorks.Edge
67 Dim i As Integer
68 Dim N3 As String
69 Dim iN3 As Long
70
71 If RCselection2.ItemCount > 1 Then MsgBox("Attention, plus d'un point est sélectionné comme troisième point!" & Chr(13) & " Seul le dernier sera pris en compte.", MsgBoxStyle.Information, "Mauvaise sélection")
72
73 Dim SelMgr As SldWorks.SelectionMgr
74 Dim swEnt As SldWorks.Entity
75 SelMgr = swModel.SelectionManager
76
77 If RCselection1.ItemCount = 0 Then MsgBox("Vous devez sélectionner au moins une arête!", MsgBoxStyle.Critical, "Impossible d'exécuter la commande") : GestionAttributPoutre = False : Exit Function
78 If RCselection2.ItemCount = 0 AndAlso Not RCCheckFacedeSection.Checked Then MsgBox("Il n'y a pas de troisième point sélectionné, l'origine sera considérée." & vbCr & "Si la poutre a une section circulaire ceci ne cause pas de prolèmes, sinon veillez modifier les informations.", MsgBoxStyle.Exclamation, "Problème potentiel")
79
80
81 ' dans les entités sélectionnées il y a un point et une ou plusieurs arêtes, faut noter le point et construire une
82 'liste des arêtes. Puis on traite la liste des arêtes.
83 Dim lst_poutres As New Collection
84
85 For i = 1 To SelMgr.GetSelectedObjectCount
86
87 'MsgBox(SelMgr.GetSelectedObjectType2(i))
88 Select Case SelMgr.GetSelectedObjectType2(i)
89
90 Case swSelectType_e.swSelEDGES, swSelectType_e.swSelREFEDGES 'on a une arète
91 swEnt = SelMgr.GetSelectedObject5(i)
92
93 swArete = swEnt
94
95 ' on se débarasse des arètes qui sont sur une coque ou sur un volume
96 Dim testArete As Object
97 testArete = swArete.GetTwoAdjacentFaces2()
98
99
100 If testArete(1) Is Nothing And testArete(0) Is Nothing Then 'MsgBox("L'arête est une poutre")
101 lst_poutres.Add(swEnt)
102
103 ElseIf testArete(1) Is Nothing Then
104 MsgBox("Une arête sélectionnée appartient à une coque. Elle ne sera pas prise en compte", MsgBoxStyle.Information)
105 Else : MsgBox("Une arête sélectionnée appartient à un volume. Elle ne sera pas prise en compte", MsgBoxStyle.Information)
106 End If
107
108 Case swSelectType_e.swSelVERTICES, swSelectType_e.swSelSKETCHPOINTS, swSelectType_e.swSelEXTSKETCHPOINTS
109 obj = SelMgr.GetSelectedObject5(i)
110 iN3 = i
111 'N3 = Creation3iemePoint(i, SelMgr) ' attention, ça ça enlève la sélection que l'on a besoin après.
112
113 Case swSelectType_e.swSelCOORDSYS
114 ' on vient de cliquer sur un système de coordonnées.
115 swEnt = SelMgr.GetSelectedObject5(i)
116 Dim swfeat As SldWorks.Feature
117 swfeat = swEnt
118 N3 = swfeat.Name
119
120 Case Else
121 MsgBox("Dans AttributPoutre, le select case, type d'entité encore non géré... Ou encore c'est une coque..." & vbCr & "swSelectType_e. = " & SelMgr.GetSelectedObjectType2(i))
122 ' on avait un truc de trop de sélectionné...
123 End Select
124 Next i
125
126 N3 = Creation3iemePoint(iN3, SelMgr)
127
128 For Each swEnt In lst_poutres
129 If Not CreationAttributPourPoutre(swEnt, N3) Then GestionAttributPoutre = False : Exit Function
130 Next
131 ' maintenant la création du plan qui visuellement est intéressant...
132
133
134 End Function
135
136 Private Sub PlanDePoutre(ByRef N3 As String, ByRef poutre As SldWorks.Edge)
137 Try ' au cas où, c'est une option visuelle qui n'est pas nécessaire...
138
139 Catch ex As Exception
140
141 End Try
142 End Sub
143
144
145 ''' <summary>
146 ''' Function qui créé un repère là où devrait être le troisième point
147 ''' </summary>
148 ''' <param name="i">Le numéro de l'entité sélectionné</param>
149 ''' <param name="selMgr">Le selection manager</param>
150 ''' <returns>Le nom du troisième point</returns>
151 ''' <remarks></remarks>
152 Public Function Creation3iemePoint(ByRef i As Long, Optional ByRef selMgr As SldWorks.SelectionMgr = Nothing) As String
153 ' function qui créé le système de coordonné en retournant son nom
154 Dim j As Integer
155 Dim liste() As Object 'SldWorks.Entity
156 Dim swEnt As SldWorks.Entity
157 Static compteur As Long
158
159
160 If selMgr Is Nothing Then selMgr = swModel.SelectionManager
161
162 ReDim liste(selMgr.GetSelectedObjectCount)
163 For j = 1 To selMgr.GetSelectedObjectCount
164 liste(j) = selMgr.GetSelectedObject5(j)
165 Next
166 Dim ttt As Integer
167
168 ttt = selMgr.GetSelectedObjectType(i)
169 ' pour éviter les maux de têtes, on désélectionne tout, puis on sélectionne juste le point et on y ajoute un syscoord
170 If i <> 0 Then
171 Select Case selMgr.GetSelectedObjectType(i)
172
173 Case 0
174 MsgBox("Selon Solidworks ... il n'y a rien de sélectionner!")
175
176 Case 3
177 swEnt = selMgr.GetSelectedObject(i)
178 swModel.ClearSelection2(True)
179 'swEnt.Select2(False, 1)
180 swEnt.SelectByMark(True, 1)
181
182
183 Case SwConst.swSelectType_e.swSelEXTSKETCHPOINTS
184 Dim obj As Object
185 selMgr = swModel.SelectionManager
186 obj = selMgr.GetSelectedObject5(i)
187 swModel.ClearSelection2(True)
188 obj.Select2(False, 1) ' faut mettre le mark à 1
189 obj.SelectByMark(True, 1)
190 Case Else
191 MsgBox("Entité inconnue sélectionnée...")
192
193 End Select
194 End If
195
196 swModel.InsertCoordinateSystem(False, False, False)
197
198 'swModel.EditRebuild3()
199 swEnt = swModel.FeatureByPositionReverse(0)
200 swEnt.Select(False)
201
202 Do While Not swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "Point3#" & compteur) ' on met 1 pour ne pas supress le truc
203 compteur += 1 'pas optimisé en vitesse, mais pas nécessaire
204 Loop
205
206 swModel.ClearSelection2(True)
207
208 ' on resélectionne tout ce qu'il y a dans la liste
209 For j = 1 To UBound(liste)
210 liste(j).Select(True)
211 Next
212
213
214 Creation3iemePoint = "Point3#" & compteur
215 Commun.GererDossiers("Poutres", "Point3#" & compteur)
216 compteur += 1
217
218
219 End Function
220
221
222 Public Sub PopulerCombo(Optional ByVal premier As Boolean = False)
223 ' sub qui sert à mettre des informations dans les comboBox...
224 Static lst_mat As New Collection
225
226 Static listecree As Boolean
227 Dim sec As sectionPoutre
228
229 If Not listecree Then
230 Dim mat As materiau
231 mat.nom = "Acier"
232 mat.E = 300000
233 mat.poisson = 0.3
234 mat.sigmay = 200000
235 lst_mat.Add(mat, mat.nom)
236
237 mat.nom = "Aluminium"
238 mat.E = 200000
239 mat.poisson = 0.28
240 mat.sigmay = 150000
241 lst_mat.Add(mat, mat.nom)
242
243
244
245 ' liste des sections de poutres
246 sec.nom = "S3 x 5.7"
247 sec.Aire = 1.67 * 0.00064516
248 sec.D1 = 3 * 0.0254
249 sec.D2 = 2.33 * 0.0254
250 sec.D3 = 0.26 * 0.0254
251 sec.D4 = 0.17 * 0.0254
252 sec.I1 = 2.52 * 0.0000004162364471
253 sec.I2 = 0.455 * 0.0000004162364471
254 lst_Section.Add(sec, sec.nom)
255
256 sec.nom = "S3 x 7.5"
257 sec.Aire = 2.21 * 0.00064516
258 sec.D1 = 3 * 0.0254
259 sec.D2 = 2.509 * 0.0254
260 sec.D3 = 0.26 * 0.0254
261 sec.D4 = 0.349 * 0.0254
262 sec.I1 = 2.93 * 0.0000004162364471
263 sec.I2 = 0.586 * 0.0000004162364471
264 lst_Section.Add(sec, sec.nom)
265
266 sec.nom = "S4 x 7.7"
267 sec.Aire = 2.26 * 0.00064516
268 sec.D1 = 4 * 0.0254
269 sec.D2 = 2.663 * 0.0254
270 sec.D3 = 0.293 * 0.0254
271 sec.D4 = 0.193 * 0.0254
272 sec.I1 = 6.08 * 0.0000004162364471
273 sec.I2 = 0.764 * 0.0000004162364471
274 lst_Section.Add(sec, sec.nom)
275
276 sec.nom = "S4 x 9.5"
277 sec.Aire = 2.79 * 0.00064516
278 sec.D1 = 4 * 0.0254
279 sec.D2 = 2.796 * 0.0254
280 sec.D3 = 0.293 * 0.0254
281 sec.D4 = 0.326 * 0.0254
282 sec.I1 = 6.79 * 0.0000004162364471
283 sec.I2 = 0.903 * 0.0000004162364471
284 lst_Section.Add(sec, sec.nom)
285
286 sec.nom = "S5 x 10"
287 sec.Aire = 2.94 * 0.00064516
288 sec.D1 = 5 * 0.0254
289 sec.D2 = 3.004 * 0.0254
290 sec.D3 = 0.326 * 0.0254
291 sec.D4 = 0.214 * 0.0254
292 sec.I1 = 12.3 * 0.0000004162364471
293 sec.I2 = 1.22 * 0.0000004162364471
294 lst_Section.Add(sec, sec.nom)
295
296 sec.nom = "S5 x 14.75"
297 sec.Aire = 4.34 * 0.00064516
298 sec.D1 = 5 * 0.0254
299 sec.D2 = 3.284 * 0.0254
300 sec.D3 = 0.326 * 0.0254
301 sec.D4 = 0.494 * 0.0254
302 sec.I1 = 15.2 * 0.0000004162364471
303 sec.I2 = 1.67 * 0.0000004162364471
304 lst_Section.Add(sec, sec.nom)
305
306 sec.nom = "STube 3 x 2.5 x 0.5"
307 sec.Aire = 4.34 * 0.00064516
308 sec.D1 = 3 * 0.0254
309 sec.D2 = 2.5 * 0.0254
310 sec.D3 = 0.5 * 0.0254
311 sec.D4 = 0
312 sec.I1 = 10 * 0.0000004162364471 ' aléatoire
313 sec.I2 = 8 * 0.0000004162364471 ' aléatoire
314 lst_Section.Add(sec, sec.nom)
315
316
317 sec.nom = "Tube 2 x 0.5"
318 sec.Aire = 4.34 * 0.00064516
319 sec.D1 = 2 * 0.0254
320 sec.D2 = 2 * 0.0254
321 sec.D3 = 0.5 * 0.0254
322 sec.D4 = 0
323 sec.I1 = 10 * 0.0000004162364471 ' aléatoire
324 sec.I2 = 8 * 0.0000004162364471 ' aléatoire
325 lst_Section.Add(sec, sec.nom)
326
327
328 sec.nom = "C 3 x 4.1"
329 sec.Aire = 1.21 * 0.00064516 ' aléatoire
330 sec.D1 = 3 * 0.0254 ' aléatoire
331 sec.D2 = 1 * 0.0254 ' aléatoire
332 sec.D3 = 0.2 * 0.0254 ' aléatoire
333 sec.D4 = 0.2 * 0.0254 ' aléatoire
334 sec.D5 = 0.1 * 0.0254 ' aléatoire
335 sec.I1 = 1.66 * 0.0000004162364471 ' aléatoire
336 sec.I2 = 1 * 0.0000004162364471 ' aléatoire
337 lst_Section.Add(sec, sec.nom)
338
339
340 sec.nom = "LAngle 3 x 3 x.25"
341 sec.Aire = 1.21 * 0.00064516 ' aléatoire
342 sec.D1 = 3 * 0.0254 ' aléatoire
343 sec.D2 = 3 * 0.0254 ' aléatoire
344 sec.D3 = 0.25 * 0.0254 ' aléatoire
345 sec.D4 = 0.25 * 0.0254 ' aléatoire
346 sec.D5 = 0.35 * 0.0254 ' aléatoire
347 sec.D6 = 0.35 * 0.0254 ' aléatoire
348 sec.I1 = 1.66 * 0.0000004162364471 ' aléatoire
349 sec.I2 = 1 * 0.0000004162364471 ' aléatoire
350 lst_Section.Add(sec, sec.nom)
351
352
353 sec.nom = "T 3 x 2"
354 sec.Aire = 1.21 * 0.00064516 ' aléatoire
355 sec.D1 = 3 * 0.0254 ' aléatoire
356 sec.D2 = 2.5 * 0.0254 ' aléatoire
357 sec.D3 = 0.25 * 0.0254 ' aléatoire
358 sec.D4 = 0.25 * 0.0254 ' aléatoire
359 sec.D5 = 2 * 0.0254 ' aléatoire
360 sec.I1 = 1.66 * 0.0000004162364471 ' aléatoire
361 sec.I2 = 1 * 0.0000004162364471 ' aléatoire
362 lst_Section.Add(sec, sec.nom)
363
364
365 sec.nom = "Pipe 3 "
366 sec.Aire = 1.21 * 0.00064516 ' aléatoire
367 sec.D1 = 3 * 0.0254 ' aléatoire
368 sec.I1 = 1.66 * 0.0000004162364471 ' aléatoire
369 sec.I2 = 1 * 0.0000004162364471 ' aléatoire
370 lst_Section.Add(sec, sec.nom)
371
372 sec.nom = " Rectangle générique"
373 sec.Aire = 0.1 ' aléatoire
374 sec.D1 = 0.1 ' aléatoire
375 sec.D2 = 0.1
376 sec.I1 = 0.0000083333 ' aléatoire
377 sec.I2 = 0.0000083333 ' aléatoire
378 lst_Section.Add(sec, sec.nom)
379
380
381 sec.nom = " Poutre en I générique"
382 sec.Aire = 1.21 * 0.00064516 ' aléatoire
383 sec.D1 = 3 * 0.0254 ' aléatoire
384 sec.D2 = 2.5 * 0.0254 ' aléatoire
385 sec.D3 = 0.25 * 0.0254 ' aléatoire
386 sec.D4 = 0.25 * 0.0254 ' aléatoire
387 sec.D5 = 2 * 0.0254 ' aléatoire
388 sec.I1 = 1.66 * 0.0000004162364471 ' aléatoire
389 sec.I2 = 1 * 0.0000004162364471 ' aléatoire
390 lst_Section.Add(sec, sec.nom)
391
392
393 sec.nom = " Circulaire pleine générique"
394 sec.Aire = 1
395 sec.D1 = 0.1
396 lst_Section.Add(sec, sec.nom)
397
398
399 sec.nom = " Tuyau (Pipe) générique"
400 sec.Aire = 0.1
401 sec.D1 = 0.1
402 sec.D3 = 0.05
403 lst_Section.Add(sec, sec.nom)
404
405
406 sec.nom = " Tube carré générique"
407 sec.Aire = 0.1
408 sec.D1 = 0.1
409 sec.D2 = 0.1
410 sec.D3 = 0.02
411 lst_Section.Add(sec, sec.nom)
412
413
414 sec.nom = " Poutre en C générique"
415 sec.Aire = 0.1
416 sec.D1 = 0.1
417 sec.D2 = 0.1
418 sec.D3 = 0.02
419 sec.D4 = 0.02
420 sec.D5 = 0.02
421 lst_Section.Add(sec, sec.nom)
422
423 sec.nom = " Poutre en L générique"
424 sec.Aire = 0.1
425 sec.D1 = 0.1
426 sec.D2 = 0.1
427 sec.D3 = 0.02
428 sec.D4 = 0.02
429 sec.D5 = 0.02
430 sec.D6 = 0.02
431 lst_Section.Add(sec, sec.nom)
432
433 sec.nom = " Poutre en T générique"
434 sec.Aire = 0.1
435 sec.D1 = 0.1
436 sec.D2 = 0.1
437 sec.D3 = 0.02
438 sec.D4 = 0.02
439 sec.D5 = 0.02
440 lst_Section.Add(sec, sec.nom)
441
442
443
444 ' combo1 Matériaux
445 Dim i As materiau
446 For Each i In lst_mat
447 RCcombo1.AddItems(i.nom)
448 RCcombo3.AddItems(i.nom)
449 Next i
450
451 Dim j As sectionPoutre
452 For Each j In lst_Section
453 RCcombo2.AddItems(j.nom)
454 Next j
455 listecree = True
456 End If
457
458 ' on met les bonnes valeurs dans les combobox en fonction de quel type de section est sélectionné
459 Dim nom As String
460 If premier Then nom = lst_Section.Item(1).nom Else nom = RCcombo2.ItemText(RCcombo2.CurrentSelection)
461
462 sec = lst_Section.Item(nom)
463 InfoPoutres(0)
464
465 End Sub
466
467
468
469 Public Sub InfoPoutres(ByVal code As Integer)
470
471 Dim sec As sectionPoutre
472 Dim ContenuCombo As String
473 Dim Ixx As Double, Iyy As Double, Aire As Double
474 ' 1 - trouver quelle section est affichée
475 ContenuCombo = RCcombo2.ItemText(-1)
476
477 ' on n'accepte pas les changements d'infos des poutres des tables. si on veut des modifs, on va choisir les poutres de type générique.
478
479 For Each sec In lst_Section
480 If sec.nom = ContenuCombo Then Exit For
481 Next sec
482
483 'Select Case code
484 ' Case 14 ' change la valeur de D1
485 ' Case 16 ' change D2
486 ' Case 18 ' change d3
487 ' Case 20 ' change d4
488 ' Case 22 ' change d5
489 ' Case 24 ' change d6
490 ' Case 10, 12, 31 ' aire ou inertie de changé
491 ' ' on ne fait rien pour l'instant
492 ' Case 0 ' change la section
493
494 If code = 10 Or code = 12 Or code = 31 Then Exit Sub
495
496 If ContenuCombo = " Rectangle générique" Then
497 RCCode.InertieRectangle(RCNumberboxD1.Value, RCNumberboxD2.Value, Aire, Ixx, Iyy)
498 RCNumberbox1.Value = Ixx
499 RCNumberbox2.Value = Iyy
500 LabelD1.Caption = "Longueur D1 "
501 LabelD2.Caption = "Longueur D2 "
502 RCNumberboxD3.Value = 0 : LabelD3.Caption = "Innutile"
503 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
504 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
505 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
506 RCNumberbox5.Value = Aire
507
508
509 ElseIf ContenuCombo = " Poutre en I générique" Then
510 RCCode.InertiePoutreI(RCNumberboxD1.Value, RCNumberboxD2.Value, RCNumberboxD3.Value, RCNumberboxD4.Value, Aire, Ixx, Iyy)
511 RCNumberbox1.Value = Ixx
512 RCNumberbox2.Value = Iyy
513 LabelD1.Caption = "Longueur D1 "
514 LabelD2.Caption = "Longueur D2 "
515 LabelD3.Caption = "Longueur D3 "
516 LabelD4.Caption = "Longueur D4 "
517 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
518 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
519 RCNumberbox5.Value = Aire
520
521 ElseIf ContenuCombo = " Circulaire pleine générique" Then
522 RCCode.InertieCirculairePlein(RCNumberboxD1.Value, Aire, Ixx, Iyy)
523 RCNumberbox1.Value = Ixx
524 RCNumberbox2.Value = Iyy
525 LabelD1.Caption = "Diamètre D1 "
526 RCNumberboxD2.Value = 0 : LabelD2.Caption = "Innutile"
527 RCNumberboxD3.Value = 0 : LabelD3.Caption = "Innutile"
528 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
529 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
530 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
531 RCNumberbox5.Value = Aire
532
533 ElseIf ContenuCombo = " Tuyau (Pipe) générique" Then
534 RCCode.InertiePipe(RCNumberboxD1.Value, RCNumberboxD3.Value, Aire, Ixx, Iyy)
535 RCNumberbox1.Value = Ixx
536 RCNumberbox2.Value = Iyy
537 LabelD1.Caption = "Diamètre D1 "
538 RCNumberboxD2.Value = 0 : LabelD2.Caption = "Innutile"
539 LabelD3.Caption = "Épaisseur "
540 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
541 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
542 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
543 RCNumberbox5.Value = Aire
544
545 ElseIf ContenuCombo = " Tube carré générique" Then
546 RCCode.InertieTube(RCNumberboxD1.Value, RCNumberboxD2.Value, RCNumberboxD3.Value, Aire, Ixx, Iyy)
547 RCNumberbox1.Value = Ixx
548 RCNumberbox2.Value = Iyy
549 LabelD1.Caption = "Longueur D1 "
550 LabelD2.Caption = "Largeur D2 "
551 LabelD3.Caption = "Épaisseur D3 "
552 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
553 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
554 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
555 RCNumberbox5.Value = Aire
556
557 ElseIf ContenuCombo = " Poutre en C générique" Then
558 RCCode.InertieC(RCNumberboxD1.Value, RCNumberboxD2.Value, RCNumberboxD3.Value, RCNumberboxD4.Value, RCNumberboxD5.Value, Aire, Ixx, Iyy)
559 RCNumberbox1.Value = Ixx
560 RCNumberbox2.Value = Iyy
561 LabelD1.Caption = "Longueur D1 "
562 LabelD2.Caption = "Largeur D2 "
563 LabelD3.Caption = "Épaisseur D3 "
564 LabelD4.Caption = "Épaisseur D4 "
565 LabelD5.Caption = "Distance D5 "
566 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
567 RCNumberbox5.Value = Aire
568
569 ElseIf ContenuCombo = " Poutre en L générique" Then
570 RCCode.InertieL(RCNumberboxD1.Value, RCNumberboxD2.Value, RCNumberboxD3.Value, RCNumberboxD4.Value, RCNumberboxD5.Value, RCNumberboxD6.Value, Aire, Ixx, Iyy)
571 RCNumberbox1.Value = Ixx
572 RCNumberbox2.Value = Iyy
573 LabelD1.Caption = "Longueur D1 "
574 LabelD2.Caption = "Largeur D2 "
575 LabelD3.Caption = "Épaisseur D3 "
576 LabelD4.Caption = "Épaisseur D4 "
577 LabelD5.Caption = "Distance D5 "
578 LabelD6.Caption = "Distance D6 "
579 RCNumberbox5.Value = Aire
580
581
582 ElseIf ContenuCombo = " Poutre en T générique" Then
583 RCCode.InertieT(RCNumberboxD1.Value, RCNumberboxD2.Value, RCNumberboxD3.Value, RCNumberboxD4.Value, RCNumberboxD5.Value, Aire, Ixx, Iyy)
584 RCNumberbox1.Value = Ixx
585 RCNumberbox2.Value = Iyy
586 LabelD1.Caption = "Longueur D1 "
587 LabelD2.Caption = "Largeur D2 "
588 LabelD3.Caption = "Épaisseur D3 "
589 LabelD4.Caption = "Épaisseur D4 "
590 LabelD5.Caption = "Distance D5 "
591 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile "
592 RCNumberbox5.Value = Aire
593
594 ElseIf Left(ContenuCombo, 2) = "ST" Then ' tube carré troué
595 RCNumberbox1.Value = sec.I1
596 RCNumberbox2.Value = sec.I2
597 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 "
598 RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Largeur D2 "
599 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Épaisseur D3 "
600 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
601 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
602 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
603 RCNumberbox5.Value = sec.Aire
604
605 ElseIf Left(ContenuCombo, 1) = "S" Then ' poutre en I de type S
606 RCNumberbox1.Value = sec.I1
607 RCNumberbox2.Value = sec.I2
608 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 "
609 RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Longueur D2 "
610 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Longueur D3 "
611 RCNumberboxD4.Value = sec.D4 : LabelD4.Caption = "Longueur D4 "
612 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
613 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
614 RCNumberbox5.Value = sec.Aire
615
616 ElseIf Left(ContenuCombo, 4) = "Tube" Then ' le tube rond
617 RCNumberbox1.Value = sec.I1
618 RCNumberbox2.Value = sec.I2
619 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Diamètre D1 "
620 RCNumberboxD2.Value = 0 : LabelD2.Caption = "Innutile"
621 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Épaisseur "
622 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
623 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
624 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
625 RCNumberbox5.Value = sec.Aire
626 ElseIf Left(ContenuCombo, 1) = "C" Then ' le channel
627 RCNumberbox1.Value = sec.I1
628 RCNumberbox2.Value = sec.I2
629 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 "
630 RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Largeur D2 "
631 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Épaisseur D3 "
632 RCNumberboxD4.Value = sec.D4 : LabelD4.Caption = "Épaisseur D4 "
633 RCNumberboxD5.Value = sec.D5 : LabelD5.Caption = "Distance D5 "
634 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
635 RCNumberbox5.Value = sec.Aire
636 ElseIf Left(ContenuCombo, 1) = "L" Then ' l'Angle en L
637 RCNumberbox1.Value = Ixx
638 RCNumberbox2.Value = Iyy
639 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 "
640 RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Largeur D2 "
641 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Épaisseur D3 "
642 RCNumberboxD4.Value = sec.D4 : LabelD4.Caption = "Épaisseur D4 "
643 RCNumberboxD5.Value = sec.D5 : LabelD5.Caption = "Distance D5 "
644 RCNumberboxD6.Value = sec.D6 : LabelD6.Caption = "Distance D6 "
645 RCNumberbox5.Value = Aire
646 ElseIf Left(ContenuCombo, 1) = "T" Then ' le T
647 RCNumberbox1.Value = sec.I1
648 RCNumberbox2.Value = sec.I2
649 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 "
650 RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Largeur D2 "
651 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Épaisseur D3 "
652 RCNumberboxD4.Value = sec.D4 : LabelD4.Caption = "Épaisseur D4 "
653 RCNumberboxD5.Value = sec.D5 : LabelD5.Caption = "Distance D5 "
654 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile "
655 RCNumberbox5.Value = sec.Aire
656
657 ElseIf Left(ContenuCombo, 1) = "P" Then ' circulaire Plein
658 RCNumberbox1.Value = sec.I1
659 RCNumberbox2.Value = sec.I2
660 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Diamètre D1 "
661 RCNumberboxD2.Value = 0 : LabelD2.Caption = "Innutile"
662 RCNumberboxD3.Value = 0 : LabelD3.Caption = "Innutile"
663 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
664 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
665 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
666 RCNumberbox5.Value = sec.Aire
667 Else
668 'MsgBox("Le Else est activé dans InfoPoutres, c'est anormal, le type de section n'est pas reconnu!")
669 End If
670
671 'End Select
672
673
674 'RCNumberbox1.Value = sec.I1
675 'RCNumberbox2.Value = sec.I2
676 'RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 [m]"
677 'RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Longueur D2 [m]"
678 'RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Longueur D3 [m]"
679 'RCNumberboxD4.Value = sec.D4 : LabelD4.Caption = "Longueur D4 [m]"
680 'RCNumberboxD5.Value = sec.D5 : LabelD5.Caption = "Longueur D5 [m]"
681 'RCNumberboxD6.Value = sec.D6 : LabelD6.Caption = "Longueur D6 [m]"
682 'RCNumberbox5.Value = sec.Aire
683
684 End Sub
685
686
687 Public Function CreationAttributPourPoutre(ByRef swEnt As SldWorks.Entity, ByRef N3 As String, Optional ByRef miniPoutre As Boolean = False) As Boolean
688 Dim nom As String
689 Dim no As Long 'Static no As Long
690 Dim swArete As SldWorks.Edge
691
692 If miniPoutre Then no = Intersections.nbMinipoutre Else no = CLng(Right(N3, Len(N3) - 7))
693
694 swArete = swEnt
695 If miniPoutre Then nom = "MiniPoutre" & CStr(no) Else nom = "RCPoutre" & CStr(no)
696 Dim Attr As SldWorks.Attribute = Nothing
697
698 Try
699 Attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0) ' si l'attribut existe déjà on pointe dessus.
700 'Dim p As SldWorks.Parameter
701 '
702 'p = Attr.GetParameter("D1")
703 'MsgBox("La valeur de D1 est:" & p.GetDoubleValue)
704 Catch ex As Exception
705 'MsgBox("N'arrive pas à se lier à l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
706 End Try
707
708 If Attr Is Nothing Then Attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, swArete, nom, 0, 2) ' 0 = swThisconfig
709
710 While Attr Is Nothing
711 no += 1
712 compteur += 1
713 If miniPoutre Then nom = "MiniPoutre" & CStr(no) Else nom = "RCPoutre" & CStr(no)
714 Attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, swArete, nom, 0, 0)
715 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")
716
717 End While
718
719 Intersections.nbMinipoutre = no
720
721 Dim swAreteP As SldWorks.Edge
722 swAreteP = swEnt
723 'slyPoutre = trouver(swAreteP, Commun.tipe_e.poutre)
724 'slyPoutre.swAttribute = Attr
725
726 Dim ParamM As SldWorks.Parameter
727 Dim ParamS As SldWorks.Parameter
728 Dim ParamI1 As SldWorks.Parameter
729 Dim ParamI2 As SldWorks.Parameter
730 Dim ParamD1 As SldWorks.Parameter
731 Dim ParamD2 As SldWorks.Parameter
732 Dim ParamD3 As SldWorks.Parameter
733 Dim ParamD4 As SldWorks.Parameter
734 Dim ParamD5 As SldWorks.Parameter
735 Dim ParamD6 As SldWorks.Parameter
736 Dim ParamAs As SldWorks.Parameter
737 Dim ParamFlag As SldWorks.Parameter
738 Dim ParamN3 As SldWorks.Parameter = Nothing
739
740 ParamM = Attr.GetParameter("M")
741 ParamS = Attr.GetParameter("S")
742 ParamI1 = Attr.GetParameter("I1")
743 ParamI2 = Attr.GetParameter("I2")
744 ParamD1 = Attr.GetParameter("D1")
745 ParamD2 = Attr.GetParameter("D2")
746 ParamD3 = Attr.GetParameter("D3")
747 ParamD4 = Attr.GetParameter("D4")
748 ParamD5 = Attr.GetParameter("D5")
749 ParamD6 = Attr.GetParameter("D6")
750 ParamAs = Attr.GetParameter("As")
751 ParamFlag = Attr.GetParameter("Flag")
752
753 If Not miniPoutre Then ParamN3 = Attr.GetParameter("N3")
754
755
756
757 ' maintenant on place les valeurs.
758 ' Paramètre m:
759 Dim m As String
760 Dim s As String
761 Dim I1 As Double
762 Dim I2 As Double
763 Dim D1 As Double
764 Dim D2 As Double
765 Dim D3 As Double
766 Dim D4 As Double
767 Dim D5 As Double
768 Dim D6 As Double
769 Dim As1 As Double
770 Dim Flag As Double
771 If Not miniPoutre Then
772 m = RCcombo1.ItemText(RCcombo1.CurrentSelection)
773 s = RCcombo2.ItemText(RCcombo2.CurrentSelection)
774 I1 = RCNumberbox1.Value
775 If I1 <= 0 Then MsgBox("La valeur de l'inertie principale est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") : CreationAttributPourPoutre = False : Exit Function
776 I2 = RCNumberbox2.Value
777 If I2 <= 0 Then MsgBox("La valeur de l'inertie secondaire est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") : CreationAttributPourPoutre = False : Exit Function
778 D1 = RCNumberboxD1.Value
779 If D1 <= 0 Then MsgBox("La valeur de la longueur dans la direction principale (Ixx) est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") : CreationAttributPourPoutre = False : Exit Function
780 D2 = RCNumberboxD2.Value
781 If D2 <= 0 Then MsgBox("La valeur de la longueur dans la direction secondaire (Iyy) est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") : CreationAttributPourPoutre = False : Exit Function
782
783 D3 = RCNumberboxD3.Value
784 If D3 <= 0 Then MsgBox("La valeur de la longueur D3 est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") : CreationAttributPourPoutre = False : Exit Function
785 D4 = RCNumberboxD4.Value
786 If D4 <= 0 Then MsgBox("La valeur de la longueur D4) est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") : CreationAttributPourPoutre = False : Exit Function
787 D5 = RCNumberboxD5.Value
788 If D5 <= 0 Then MsgBox("La valeur de la longueur D5 est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") : CreationAttributPourPoutre = False : Exit Function
789 D6 = RCNumberboxD6.Value
790 If D6 <= 0 Then MsgBox("La valeur de la longueur D6) est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") : CreationAttributPourPoutre = False : Exit Function
791
792 As1 = RCNumberbox5.Value
793 If As1 <= 0 Then MsgBox("La valeur de l'aide de section est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") : CreationAttributPourPoutre = False : Exit Function
794
795 If RCCode.RCCheckFacedeSection.Checked = True Then Flag = 1 Else Flag = 0
796
797
798 Else
799 'mettre ici les valeurs pour les mini-poutres
800 m = "Materiau"
801 s = "Section"
802 I1 = 22
803 I2 = 22
804 D1 = 22
805 D2 = 22
806 As1 = 22
807 Flag = 0
808 End If
809
810
811
812 ParamM.SetStringValue2(m, 2, "") ' swAllConfiguration = 2
813 ParamS.SetStringValue2(s, 2, "")
814 ParamI1.SetDoubleValue2(I1, 2, "")
815 ParamI2.SetDoubleValue2(I2, 2, "")
816 If I1 > Commun.Imax Then Imax = I1 ' mettre la valeur maximale de IMax pour les mini-poutres infinies...
817 If I2 > Commun.Imax Then Imax = I2
818 ParamD1.SetDoubleValue2(D1, 2, "")
819 ParamD2.SetDoubleValue2(D2, 2, "")
820 ParamD3.SetDoubleValue2(D3, 2, "")
821 ParamD4.SetDoubleValue2(D4, 2, "")
822 ParamD5.SetDoubleValue2(D5, 2, "")
823 ParamD6.SetDoubleValue2(D6, 2, "")
824 ParamAs.SetDoubleValue2(As1, 2, "")
825 ParamFlag.SetDoubleValue2(Flag, 2, "")
826 If As1 < Commun.Amax Then Commun.Amax = As1
827 If Not miniPoutre Then ParamN3.SetStringValue2(N3, 2, "")
828
829 'swModel.Extension.SelectByID2(nom, "ATTRIBUTE", 0, 0, 0, False, 0, Nothing, 0)
830
831
832 GererDossiers("Poutres", nom)
833
834 no = no + 1
835 If miniPoutre Then swArete.Display(2, 1, 0, 1, True) Else swArete.Display(2, 0, 1, 0, True) ' mini-poutre = violet, poutre = vert
836
837
838 Return True
839 End Function
840
841 Private Function GestionAttributCoque() As Boolean
842 Dim swFace As SldWorks.Face2
843 Dim i As Integer
844 Dim coques() As SldWorks.Entity
845 ReDim coques(0)
846
847
848 Dim SelMgr As SldWorks.SelectionMgr
849 Dim swEnt As SldWorks.Entity
850 SelMgr = swModel.SelectionManager
851
852 If RCselection3.ItemCount = 0 Then MsgBox("Vous devez sélectionner au moins une face (coque)!", MsgBoxStyle.Critical, "Impossible d'exécuter la commande") : Exit Function
853
854 ' dans les entités sélectionnées il y a des faces.
855
856 For i = 1 To SelMgr.GetSelectedObjectCount
857
858 swEnt = SelMgr.GetSelectedObject5(i)
859 swFace = swEnt
860
861 ' on se débarasse des faces qui sont sur un volume
862 Dim corps As SldWorks.Body2
863
864 corps = swFace.GetBody()
865
866 If Not corps.GetType = SwConst.swBodyType_e.swSolidBody Then
867 If Not UBound(coques) = 0 Then ReDim Preserve coques(UBound(coques, 1) + 1)
868 coques(UBound(coques)) = swEnt
869 'If Not CreationAttributPourCoque(swEnt) Then GestionAttributCoque = False : Exit Function
870 Else
871 MsgBox("Une face sélectionnée appartient à un volume, elle ne sera pas traitée!", MsgBoxStyle.Information, "Une face n'est pas une coque")
872 End If
873 Next i
874
875 For i = 0 To UBound(coques)
876 CreationAttributPourCoque(coques(i))
877 Next
878
879
880 End Function
881
882 Public Function CreationAttributPourCoque(ByRef swEnt As SldWorks.Entity, Optional ByRef Epaisseur As Double = -1, Optional ByRef materiau As String = Nothing) As Boolean
883 Dim nom As String = Nothing
884 Static no As Long
885 Dim Flag As Double
886 Dim swFace As SldWorks.Face2
887
888 swFace = swEnt
889
890 Dim Attr As SldWorks.Attribute
891
892 Try
893 Attr = swEnt.FindAttribute(DefAttrRCCoque, 0) ' si l'attribut existe déjà on pointe dessus.
894 Catch ex As Exception
895 Attr = Nothing
896 'MsgBox("N'arrive pas à se lier à l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
897 End Try
898
899 Do While Attr Is Nothing
900 nom = "RCCoque" & CStr(no)
901 If Attr Is Nothing Then Attr = DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 2) ' 0 = swThisconfig
902 no = no + 1
903 Loop
904 Dim ParamM As SldWorks.Parameter
905 Dim ParamEp As SldWorks.Parameter
906 Dim ParamFlag As SldWorks.Parameter
907
908 ParamM = Attr.GetParameter("M")
909 ParamEp = Attr.GetParameter("Ep")
910 ParamFlag = Attr.GetParameter("Flag")
911
912 ' maintenant on place les valeurs.
913 ' Paramètre m:
914 If materiau Is Nothing Then materiau = RCcombo1.ItemText(RCcombo3.CurrentSelection)
915 If Epaisseur = -1 Then Epaisseur = RCNumberbox6.Value
916 If Epaisseur <= 0 Then MsgBox("La valeur de l'épaisseur de la coque est nulle ou inférieure à 0, veillez modifier cette valeur", MsgBoxStyle.Critical, "Une valeur doit être modifiée") : CreationAttributPourCoque = False : Exit Function
917 If RCCode.RCCheckFacedeSectionCoque.Checked = True Then Flag = 1 Else Flag = 0
918
919 ParamM.SetStringValue2(materiau, 2, "") ' swAllConfiguration = 2
920 ParamEp.SetDoubleValue2(Epaisseur, 2, "")
921 ParamFlag.SetDoubleValue2(Flag, 2, "")
922
923 GererDossiers("Coques", nom)
924
925
926 CreationAttributPourCoque = True
927 End Function
928
929 Public Sub LectureRC()
930 ' procédure qui redonne à l'utilisateur les informations concernant les attributs sélectionnés.
931 ' il y a un feature de sélectionné, ou une poutre.
932 Dim deb As New Debug_form
933 deb.Show()
934
935
936 End Sub
937
938 Private Sub InertieRectangle(ByVal d1 As Double, ByVal d2 As Double, ByRef aire As Double, ByRef Ixx As Double, ByRef Iyy As Double)
939 aire = d1 * d2
940 Iyy = d1 * d2 * d2 * d2 / 12
941 Ixx = d1 * d1 * d1 * d2 / 12
942 End Sub
943
944 Private Sub InertiePoutreI(ByVal d1 As Double, ByVal d2 As Double, ByVal d3 As Double, ByVal d4 As Double, ByRef aire As Double, ByRef Ixx As Double, ByRef Iyy As Double)
945 Dim temp As Double
946 temp = d1 / 2 - d3
947 aire = (d2 * d3 + d4 * temp) * 2
948 Ixx = ((d2 * d3 ^ 3 / 12) + (d3 * d2 * (d1 / 2 - d3 / 2) ^ 2) * 2 + (d4 * (d1 - 2 * d3) ^ 3) / 12) '/ 0.0000004162364471
949 Iyy = (((d3 * d2 ^ 3) / 12) * 2 + (d1 - 2 * d3) * d4 ^ 3 / 12)
950 End Sub
951
952 Private Sub InertieCirculairePlein(ByVal d1 As Double, ByRef aire As Double, ByRef Ixx As Double, ByRef Iyy As Double)
953 aire = Pi * (d1 / 2 ^ 2)
954 Ixx = Pi * d1 ^ 4 / 64
955 Iyy = Ixx
956 End Sub
957
958 Private Sub InertiePipe(ByVal d1 As Double, ByVal d3 As Double, ByRef aire As Double, ByRef Ixx As Double, ByRef Iyy As Double)
959 aire = Pi * (d1 / 2 ^ 2) - Pi * (d1 / 2 - d3) ^ 2
960 Ixx = Pi * d1 ^ 4 / 64
961 Iyy = Ixx
962 End Sub
963
964 Private Sub InertieTube(ByVal d1 As Double, ByVal d2 As Double, ByVal d3 As Double, ByRef aire As Double, ByRef Ixx As Double, ByRef Iyy As Double)
965 Dim b1 As Double, b2 As Double
966 b1 = d1 - 2 * d3 : b2 = d2 - 2 * d3
967 aire = (d1 * d2) - ((b1) * (b2))
968 Ixx = (d2 * d1 ^ 3 / 12) - (b2 * b1 ^ 3 / 12)
969 Iyy = (d1 * d2 ^ 3 / 12) - (b1 * b2 ^ 3 / 12)
970 End Sub
971
972 Private Sub InertieC(ByVal d1 As Double, ByVal d2 As Double, ByVal d3 As Double, ByVal d4 As Double, ByVal d5 As Double, ByRef aire As Double, ByRef Ixx As Double, ByRef Iyy As Double)
973 Dim a As Double, b As Double
974 a = d5 + d4 - d2 / 2
975 b = d5 + d4 / 2
976
977 aire = d4 * (d1 - 2 * d3) + (d2 * d3) * 2
978 Ixx = (d2 * d3 ^ 3 / 12 + d2 * d3 * (d1 / 2 - d3 / 2) ^ 2) * 2 + d4 * (d1 - 2 * d3) ^ 3
979 Iyy = ((d1 - 2 * d3) * d4 ^ 3 / 12 + (d1 - 2 * d3) * d4 * b ^ 2) + (d3 * d2 ^ 3 / 12 + d3 * d2 * a ^ 2) * 2
980 End Sub
981
982 Private Sub InertieL(ByVal d1 As Double, ByVal d2 As Double, ByVal d3 As Double, ByVal d4 As Double, ByVal d5 As Double, ByVal d6 As Double, ByRef aire As Double, ByRef Ixx As Double, ByRef Iyy As Double)
983 aire = d3 * d2 + d4 * (d1 - d3)
984 Ixx = d2 * d3 ^ 3 / 12 + (d2 - d3) * (d5 - d3 / 2) ^ 2 + d4 * (d1 - d3) ^ 3 / 12 + d4 * (d1 - d3) * ((d1 - d3) / 2 - d5) ^ 2
985 Iyy = d3 * d2 ^ 3 / 12 + d3 * d2 * (d2 / 2 - d6) ^ 2 + (d1 - d3) * d4 ^ 3 / 12 + (d1 - d3) * d4 * (d6 - d4 / 2) ^ 2
986 End Sub
987
988 Private Sub InertieT(ByVal d1 As Double, ByVal d2 As Double, ByVal d3 As Double, ByVal d4 As Double, ByVal d5 As Double, ByRef aire As Double, ByRef Ixx As Double, ByRef Iyy As Double)
989 aire = d2 * d3 + (d1 - d3) * d4
990 Ixx = d2 * d3 ^ 3 / 12 + d3 * d2 * ((d1 - d5 - d3 / 2) ^ 2) + d4 * (d1 - d3) ^ 3 / 12 + d4 * (d1 - d3) * ((d1 - d3) / 2 - d5) ^ 2
991 Iyy = d3 * d2 ^ 3 / 12 + (d1 - d3) * d4 ^ 3 / 12
992 End Sub
993
994
995
996 End Module
997
998 End Namespace