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

# User Rev Content
1 bournival 48 Imports SolidWorks.Interop
2     Imports SolidWorks.Interop.swconst
3     Imports SolidWorks.Interop.swpublished
4 bournival 40
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