ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SlyAretePoutre.vb
Revision: 205
Committed: Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size: 23059 byte(s)
Log Message:
Commit de MAGiC_SLD pendant que j'y pense.  Les modifications ne devraient pas concerner personne d'autre que moi.   -- Sylvain

File Contents

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