ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/RCCode.vb
Revision: 48
Committed: Wed Aug 22 21:18:12 2007 UTC (17 years, 8 months ago) by bournival
File size: 46929 byte(s)
Log Message:
On passe aux nouveaux .dll

File Contents

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