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

# User Rev Content
1 bournival 40 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