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 (18 years ago) by bournival
File size: 20473 byte(s)
Log Message:
Projet de these de Sylvain Bournival. Attention projet VB.

File Contents

# Content
1 ''' <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