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

File Contents

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