ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/RCCode.vb
Revision: 130
Committed: Wed Jul 30 21:26:03 2008 UTC (16 years, 9 months ago) by bournival
File size: 54690 byte(s)
Log Message:
Une mise à jour, car on aura peut-être besoin de mon code.

File Contents

# Content
1 Imports SolidWorks.Interop
2 Imports SolidWorks.Interop.swconst
3 Imports SolidWorks.Interop.swpublished
4
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 lstSelection1 As New Collections.Generic.List(Of sldworks.Entity) ' poutre
42 Private lstSelection2 As New Collections.Generic.List(Of Object) ' troisième point
43 Private lstSelection3 As New Collections.Generic.List(Of sldworks.Entity) ' coque
44
45 Private FaceDeSectionPoutre As Boolean
46 Private FaceDeSectionCoque As Boolean
47 Private ModEpaisseur As Double
48 Private GroupPoutre1 As Boolean
49 Private GroupCoque1 As Boolean
50
51 Private m As String
52 Private s As String
53 Private I1 As Double
54 Private I2 As Double
55 Private D1 As Double
56 Private D2 As Double
57 Private D3 As Double
58 Private D4 As Double
59 Private D5 As Double
60 Private D6 As Double
61 Private As1 As Double
62 Private Flag As Double
63
64
65 Private Structure materiau
66 Dim nom As String
67 Dim E As Double
68 Dim sigmay As Double
69 Dim poisson As Double
70 End Structure
71
72
73 ''' <summary>
74 ''' Niaiserie nécessaire pour éviter un PureVirtualFnction Call
75 ''' </summary>
76 ''' <remarks></remarks>
77 Public Sub memoriser()
78 Dim selMgr As sldworks.SelectionMgr = swModel.SelectionManager
79 Dim swEnt As sldworks.Entity
80 FaceDeSectionCoque = RCCheckFacedeSectionCoque.Checked
81 FaceDeSectionPoutre = RCCheckFacedeSection.Checked
82 ModEpaisseur = RCNumberbox6.Value
83 GroupCoque1 = GroupCoque.Checked
84 GroupPoutre1 = GroupPoutre.Checked
85 lstSelection1.Clear()
86 lstSelection2.Clear()
87 lstSelection3.Clear()
88 For i As Integer = 1 To selMgr.GetSelectedObjectCount2(-1) + 1
89 If selMgr.GetSelectedObjectType3(i, -1) = swconst.swSelectType_e.swSelFACES Then
90 swEnt = selMgr.GetSelectedObject6(i, -1) : lstSelection3.Add(swEnt)
91 End If
92 Next
93
94 ' bon, faut aussi mémoriser les infos des poutres...
95
96 'swSelectType_e.swSelVERTICES, swSelectType_e.swSelSKETCHPOINTS, swSelectType_e.swSelEXTSKETCHPOINTS
97
98 For i As Integer = 1 To selMgr.GetSelectedObjectCount2(-1) + 1
99 If selMgr.GetSelectedObjectType3(i, -1) = swconst.swSelectType_e.swSelEDGES Or selMgr.GetSelectedObjectType3(i, -1) = &H33 Then
100 swEnt = selMgr.GetSelectedObject6(i, -1) : lstSelection1.Add(swEnt)
101 End If
102 Next
103
104 For i As Integer = 1 To selMgr.GetSelectedObjectCount2(-1) + 1
105 If selMgr.GetSelectedObjectType3(i, -1) = swconst.swSelectType_e.swSelPOINTREFS Or selMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelVERTICES Or selMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelSKETCHPOINTS Then
106 swEnt = selMgr.GetSelectedObject6(i, -1) : lstSelection2.Add(swEnt)
107 End If
108 If selMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelEXTSKETCHPOINTS Then
109 Dim obj As Object
110 obj = selMgr.GetSelectedObject6(i, -1)
111 lstSelection2.Add(obj)
112 End If
113 Next
114
115
116
117 m = RCcombo1.ItemText(RCcombo1.CurrentSelection)
118 s = RCcombo2.ItemText(RCcombo2.CurrentSelection)
119 I1 = RCNumberbox1.Value
120 If I1 <= 0 Then MsgBox("La valeur de l'inertie principale est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") ' : CreationAttributPourPoutre = False : Exit Sub
121 I2 = RCNumberbox2.Value
122 If I2 <= 0 Then MsgBox("La valeur de l'inertie secondaire est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") ': CreationAttributPourPoutre = False : Exit Sub
123 D1 = RCNumberboxD1.Value
124 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 Sub
125 D2 = RCNumberboxD2.Value
126 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 Sub
127
128 D3 = RCNumberboxD3.Value
129 If D3 <= 0 Then MsgBox("La valeur de la longueur D3 est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") ' : CreationAttributPourPoutre = False : Exit Sub
130 D4 = RCNumberboxD4.Value
131 If D4 <= 0 Then MsgBox("La valeur de la longueur D4) est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") ' : CreationAttributPourPoutre = False : Exit Sub
132 D5 = RCNumberboxD5.Value
133 If D5 <= 0 Then MsgBox("La valeur de la longueur D5 est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") ': CreationAttributPourPoutre = False : Exit Sub
134 D6 = RCNumberboxD6.Value
135 If D6 <= 0 Then MsgBox("La valeur de la longueur D6) est incorrecte", MsgBoxStyle.Critical, "Une valeur doit être modifiée") ': CreationAttributPourPoutre = False : Exit Sub
136
137 As1 = RCNumberbox5.Value
138 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 Sub
139
140
141 End Sub
142
143
144 Public Function debut() As Boolean
145
146 RegisterAttribut()
147 If GroupPoutre1 Then
148 If Not GestionAttributPoutre() Then Return False Else Return True
149 End If
150 If GroupCoque1 = True Then
151 If Not GestionAttributCoque() Then Return False Else Return True
152 End If
153 If GroupPoutre.Checked = False AndAlso GroupCoque1 = 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")
154
155 End Function
156
157
158
159
160 Private Function GestionAttributPoutre() As Boolean
161 ' sub qui vient lire les infos de la page des RC
162
163 Dim obj As Object
164 Dim swArete As SldWorks.Edge
165
166 Dim N3 As String = CStr(Rnd())
167
168
169 If lstSelection2.Count > 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")
170
171
172 Dim SelMgr As sldworks.SelectionMgr
173 Dim swEnt As sldworks.Entity
174 SelMgr = swModel.SelectionManager
175
176 If lstSelection1.Count = 0 Then MsgBox("Vous devez sélectionner au moins une arête!", MsgBoxStyle.Critical, "Impossible d'exécuter la commande") : GestionAttributPoutre = False : Exit Function
177 If lstSelection2.Count = 0 AndAlso Not FaceDeSectionPoutre 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")
178
179
180 ' 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
181 'liste des arêtes. Puis on traite la liste des arêtes.
182 Dim lst_poutres As New Collection
183
184
185 For z As Integer = 0 To lstSelection1.Count - 1
186
187 swEnt = lstSelection1.Item(z)
188
189 swArete = swEnt
190
191 ' on se débarasse des arètes qui sont sur une coque ou sur un volume
192 Dim testArete As Object
193 testArete = swArete.GetTwoAdjacentFaces2()
194
195 If testArete(1) Is Nothing And testArete(0) Is Nothing Then 'MsgBox("L'arête est une poutre")
196 lst_poutres.Add(swEnt)
197
198 ElseIf testArete(1) Is Nothing Then
199 MsgBox("Une arête sélectionnée appartient à une coque. Elle ne sera pas prise en compte", MsgBoxStyle.Information)
200 Else : MsgBox("Une arête sélectionnée appartient à un volume. Elle ne sera pas prise en compte", MsgBoxStyle.Information)
201 End If
202 Next
203
204
205 For z As Integer = 0 To lstSelection2.Count - 1
206 obj = lstSelection2.Item(z) 'SelMgr.GetSelectedObject5(i)
207
208 N3 = Creation3iemePoint(obj) ', SelMgr)
209 'iN3 = i
210 'N3 = Creation3iemePoint(i, SelMgr) ' attention, ça ça enlève la sélection que l'on a besoin après.
211 Next
212
213
214 ' For i = 1 'SelMgr.GetSelectedObjectCount
215 ' Select Case SelMgr.GetSelectedObjectType2(i)
216
217 ' Case swSelectType_e.swSelEDGES, swSelectType_e.swSelREFEDGES 'on a une arète
218 ' swEnt = SelMgr.GetSelectedObject5(i)
219
220 ' swArete = swEnt
221
222 ' ' on se débarasse des arètes qui sont sur une coque ou sur un volume
223 ' Dim testArete As Object
224 ' testArete = swArete.GetTwoAdjacentFaces2()
225
226
227 ' If testArete(1) Is Nothing And testArete(0) Is Nothing Then 'MsgBox("L'arête est une poutre")
228 ' lst_poutres.Add(swEnt)
229
230 ' ElseIf testArete(1) Is Nothing Then
231 ' MsgBox("Une arête sélectionnée appartient à une coque. Elle ne sera pas prise en compte", MsgBoxStyle.Information)
232 ' Else : MsgBox("Une arête sélectionnée appartient à un volume. Elle ne sera pas prise en compte", MsgBoxStyle.Information)
233 ' End If
234
235 ' Case swSelectType_e.swSelVERTICES, swSelectType_e.swSelSKETCHPOINTS, swSelectType_e.swSelEXTSKETCHPOINTS
236 ' obj = SelMgr.GetSelectedObject5(i)
237 ' iN3 = i
238 ' 'N3 = Creation3iemePoint(i, SelMgr) ' attention, ça ça enlève la sélection que l'on a besoin après.
239
240 ' Case swSelectType_e.swSelCOORDSYS
241 ' ' on vient de cliquer sur un système de coordonnées.
242 ' swEnt = SelMgr.GetSelectedObject5(i)
243 ' Dim swfeat As sldworks.Feature
244 ' swfeat = swEnt
245 ' N3 = swfeat.Name
246
247 ' Case Else
248 ' 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))
249 ' ' on avait un truc de trop de sélectionné...
250 ' End Select
251 'Next i
252
253
254
255 For Each swEnt In lst_poutres
256 If Not CreationAttributPourPoutre(swEnt, N3) Then GestionAttributPoutre = False : Exit Function
257 Next
258
259 Return True
260 End Function
261
262 Private Sub PlanDePoutre(ByRef N3 As String, ByRef poutre As SldWorks.Edge)
263 Try ' au cas où, c'est une option visuelle qui n'est pas nécessaire...
264
265 Catch ex As Exception
266
267 End Try
268 End Sub
269
270
271 ''' <summary>
272 ''' Function qui créé un repère là où devrait être le troisième point
273 ''' </summary>
274 ''' <returns>Le nom du troisième point</returns>
275 ''' <remarks></remarks>
276 Public Function Creation3iemePoint(ByVal obj As Object) As String '(ByRef i As Long, Optional ByRef selMgr As SldWorks.SelectionMgr = Nothing) As String
277 ' function qui créé le système de coordonné en retournant son nom
278 'Dim j As Integer
279 'Dim liste() As Object 'SldWorks.Entity
280 ' Dim swEnt As sldworks.Entity
281 Static compteur As Long
282
283
284 'If selMgr Is Nothing Then selMgr = swModel.SelectionManager
285
286 'ReDim liste(selMgr.GetSelectedObjectCount)
287 'For j = 1 To selMgr.GetSelectedObjectCount
288 'liste(j) = selMgr.GetSelectedObject5(j)
289 'Next
290 'Dim ttt As Integer
291 '
292 'ttt = selMgr.GetSelectedObjectType(i)
293 ' 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
294 'If i <> 0 Then
295 'Select Case swEnt.GetType 'selMgr.GetSelectedObjectType(i)
296
297 ' Case 0
298 ' MsgBox("Selon Solidworks ... il n'y a rien de sélectionner!")
299
300 ' Case 3
301
302 ' swModel.ClearSelection2(True)
303 ' 'swEnt.Select2(False, 1)
304 ' swEnt.SelectByMark(True, 1)
305
306
307 ' Case swconst.swSelectType_e.swSelEXTSKETCHPOINTS
308 ' Dim obj As Object
309 ' ' selMgr = swModel.SelectionManager
310 ' obj = swEnt ' selMgr.GetSelectedObject5(i)
311 ' swModel.ClearSelection2(True)
312 ' obj.Select2(False, 1) ' faut mettre le mark à 1
313 ' obj.SelectByMark(True, 1)
314 ' Case Else
315 ' MsgBox("Entité inconnue sélectionnée...")
316
317 'End Select
318 'End If
319
320 Dim swent As sldworks.Entity
321
322 obj.Select2(False, 1) ' faut mettre le mark à 1
323 obj.SelectByMark(True, 1)
324 swModel.InsertCoordinateSystem(False, False, False)
325
326 'swModel.EditRebuild3()
327 swEnt = swModel.FeatureByPositionReverse(0)
328 swEnt.Select(False)
329
330 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
331 compteur += 1 'pas optimisé en vitesse, mais pas nécessaire
332 Loop
333
334 swModel.ClearSelection2(True)
335
336 ' on resélectionne tout ce qu'il y a dans la liste
337 'For j = 1 To UBound(liste)
338 'liste(j).Select(True)
339 'Next
340
341
342 Creation3iemePoint = "Point3#" & compteur
343 Commun.GererDossiers("Poutres", "Point3#" & compteur)
344 compteur += 1
345
346
347 End Function
348
349
350 Public Sub PopulerCombo(Optional ByVal premier As Boolean = False)
351 ' sub qui sert à mettre des informations dans les comboBox...
352 Static lst_mat As New Collection
353
354 Static listecree As Boolean
355 Dim sec As sectionPoutre
356
357 If Not listecree Then
358 Dim mat As materiau
359 mat.nom = "Acier"
360 mat.E = 300000
361 mat.poisson = 0.3
362 mat.sigmay = 200000
363 lst_mat.Add(mat, mat.nom)
364
365 mat.nom = "Aluminium"
366 mat.E = 200000
367 mat.poisson = 0.28
368 mat.sigmay = 150000
369 lst_mat.Add(mat, mat.nom)
370
371 ' liste des sections de poutres
372 sec.nom = "S3 x 5.7"
373 sec.Aire = 1.67 * 0.00064516
374 sec.D1 = 3 * 0.0254
375 sec.D2 = 2.33 * 0.0254
376 sec.D3 = 0.26 * 0.0254
377 sec.D4 = 0.17 * 0.0254
378 sec.I1 = 2.52 * 0.0000004162364471
379 sec.I2 = 0.455 * 0.0000004162364471
380 lst_Section.Add(sec, sec.nom)
381
382 sec.nom = "S3 x 7.5"
383 sec.Aire = 2.21 * 0.00064516
384 sec.D1 = 3 * 0.0254
385 sec.D2 = 2.509 * 0.0254
386 sec.D3 = 0.26 * 0.0254
387 sec.D4 = 0.349 * 0.0254
388 sec.I1 = 2.93 * 0.0000004162364471
389 sec.I2 = 0.586 * 0.0000004162364471
390 lst_Section.Add(sec, sec.nom)
391
392 sec.nom = "S4 x 7.7"
393 sec.Aire = 2.26 * 0.00064516
394 sec.D1 = 4 * 0.0254
395 sec.D2 = 2.663 * 0.0254
396 sec.D3 = 0.293 * 0.0254
397 sec.D4 = 0.193 * 0.0254
398 sec.I1 = 6.08 * 0.0000004162364471
399 sec.I2 = 0.764 * 0.0000004162364471
400 lst_Section.Add(sec, sec.nom)
401
402 sec.nom = "S4 x 9.5"
403 sec.Aire = 2.79 * 0.00064516
404 sec.D1 = 4 * 0.0254
405 sec.D2 = 2.796 * 0.0254
406 sec.D3 = 0.293 * 0.0254
407 sec.D4 = 0.326 * 0.0254
408 sec.I1 = 6.79 * 0.0000004162364471
409 sec.I2 = 0.903 * 0.0000004162364471
410 lst_Section.Add(sec, sec.nom)
411
412 sec.nom = "S5 x 10"
413 sec.Aire = 2.94 * 0.00064516
414 sec.D1 = 5 * 0.0254
415 sec.D2 = 3.004 * 0.0254
416 sec.D3 = 0.326 * 0.0254
417 sec.D4 = 0.214 * 0.0254
418 sec.I1 = 12.3 * 0.0000004162364471
419 sec.I2 = 1.22 * 0.0000004162364471
420 lst_Section.Add(sec, sec.nom)
421
422 sec.nom = "S5 x 14.75"
423 sec.Aire = 4.34 * 0.00064516
424 sec.D1 = 5 * 0.0254
425 sec.D2 = 3.284 * 0.0254
426 sec.D3 = 0.326 * 0.0254
427 sec.D4 = 0.494 * 0.0254
428 sec.I1 = 15.2 * 0.0000004162364471
429 sec.I2 = 1.67 * 0.0000004162364471
430 lst_Section.Add(sec, sec.nom)
431
432 sec.nom = "STube 3 x 2.5 x 0.5"
433 sec.Aire = 4.34 * 0.00064516
434 sec.D1 = 3 * 0.0254
435 sec.D2 = 2.5 * 0.0254
436 sec.D3 = 0.5 * 0.0254
437 sec.D4 = 0
438 sec.I1 = 10 * 0.0000004162364471 ' aléatoire
439 sec.I2 = 8 * 0.0000004162364471 ' aléatoire
440 lst_Section.Add(sec, sec.nom)
441
442
443 sec.nom = "Tuyau 2 x 0.5"
444 sec.Aire = 4.34 * 0.00064516
445 sec.D1 = 2 * 0.0254
446 sec.D2 = 2 * 0.0254
447 sec.D3 = 0.5 * 0.0254
448 sec.D4 = 0
449 sec.I1 = 10 * 0.0000004162364471 ' aléatoire
450 sec.I2 = 8 * 0.0000004162364471 ' aléatoire
451 lst_Section.Add(sec, sec.nom)
452
453
454 sec.nom = "C 3 x 4.1"
455 sec.Aire = 1.21 * 0.00064516 ' aléatoire
456 sec.D1 = 3 * 0.0254 ' aléatoire
457 sec.D2 = 1 * 0.0254 ' aléatoire
458 sec.D3 = 0.2 * 0.0254 ' aléatoire
459 sec.D4 = 0.2 * 0.0254 ' aléatoire
460 sec.D5 = 0.1 * 0.0254 ' aléatoire
461 sec.I1 = 1.66 * 0.0000004162364471 ' aléatoire
462 sec.I2 = 1 * 0.0000004162364471 ' aléatoire
463 lst_Section.Add(sec, sec.nom)
464
465
466 sec.nom = "LAngle 3 x 3 x.25"
467 sec.Aire = 1.21 * 0.00064516 ' aléatoire
468 sec.D1 = 3 * 0.0254 ' aléatoire
469 sec.D2 = 3 * 0.0254 ' aléatoire
470 sec.D3 = 0.25 * 0.0254 ' aléatoire
471 sec.D4 = 0.25 * 0.0254 ' aléatoire
472 sec.D5 = 0.35 * 0.0254 ' aléatoire
473 sec.D6 = 0.35 * 0.0254 ' aléatoire
474 sec.I1 = 1.66 * 0.0000004162364471 ' aléatoire
475 sec.I2 = 1 * 0.0000004162364471 ' aléatoire
476 lst_Section.Add(sec, sec.nom)
477
478
479 sec.nom = "T 3 x 2"
480 sec.Aire = 1.21 * 0.00064516 ' aléatoire
481 sec.D1 = 3 * 0.0254 ' aléatoire
482 sec.D2 = 2.5 * 0.0254 ' aléatoire
483 sec.D3 = 0.25 * 0.0254 ' aléatoire
484 sec.D4 = 0.25 * 0.0254 ' aléatoire
485 sec.D5 = 2 * 0.0254 ' aléatoire
486 sec.I1 = 1.66 * 0.0000004162364471 ' aléatoire
487 sec.I2 = 1 * 0.0000004162364471 ' aléatoire
488 lst_Section.Add(sec, sec.nom)
489
490
491 sec.nom = "Cylindrique (Rod) 3 "
492 sec.Aire = 1.21 * 0.00064516 ' aléatoire
493 sec.D1 = 3 * 0.0254 ' aléatoire
494 sec.I1 = 1.66 * 0.0000004162364471 ' aléatoire
495 sec.I2 = 1 * 0.0000004162364471 ' aléatoire
496 lst_Section.Add(sec, sec.nom)
497
498 sec.nom = " Rectangle générique"
499 sec.Aire = 0.1 ' aléatoire
500 sec.D1 = 0.1 ' aléatoire
501 sec.D2 = 0.1
502 sec.I1 = 0.0000083333 ' aléatoire
503 sec.I2 = 0.0000083333 ' aléatoire
504 lst_Section.Add(sec, sec.nom)
505
506
507 sec.nom = " Poutre en I générique"
508 sec.Aire = 1.21 * 0.00064516 ' aléatoire
509 sec.D1 = 3 * 0.0254 ' aléatoire
510 sec.D2 = 2.5 * 0.0254 ' aléatoire
511 sec.D3 = 0.25 * 0.0254 ' aléatoire
512 sec.D4 = 0.25 * 0.0254 ' aléatoire
513 sec.D5 = 2 * 0.0254 ' aléatoire
514 sec.I1 = 1.66 * 0.0000004162364471 ' aléatoire
515 sec.I2 = 1 * 0.0000004162364471 ' aléatoire
516 lst_Section.Add(sec, sec.nom)
517
518
519 sec.nom = " Cylindrique (Rod) générique"
520 sec.Aire = 1
521 sec.D1 = 0.1
522 lst_Section.Add(sec, sec.nom)
523
524
525 sec.nom = " Tuyau (Pipe) générique"
526 sec.Aire = 0.1
527 sec.D1 = 0.1
528 sec.D3 = 0.05
529 lst_Section.Add(sec, sec.nom)
530
531
532 sec.nom = " Tube carré générique"
533 sec.Aire = 0.1
534 sec.D1 = 0.1
535 sec.D2 = 0.1
536 sec.D3 = 0.02
537 lst_Section.Add(sec, sec.nom)
538
539
540 sec.nom = " Poutre en C générique"
541 sec.Aire = 0.1
542 sec.D1 = 0.1
543 sec.D2 = 0.1
544 sec.D3 = 0.02
545 sec.D4 = 0.02
546 sec.D5 = 0.02
547 lst_Section.Add(sec, sec.nom)
548
549 sec.nom = " Poutre en L générique"
550 sec.Aire = 0.1
551 sec.D1 = 0.1
552 sec.D2 = 0.1
553 sec.D3 = 0.02
554 sec.D4 = 0.02
555 sec.D5 = 0.02
556 sec.D6 = 0.02
557 lst_Section.Add(sec, sec.nom)
558
559 sec.nom = " Poutre en T générique"
560 sec.Aire = 0.1
561 sec.D1 = 0.1
562 sec.D2 = 0.1
563 sec.D3 = 0.02
564 sec.D4 = 0.02
565 sec.D5 = 0.02
566 lst_Section.Add(sec, sec.nom)
567
568
569
570 ' combo1 Matériaux
571 Dim i As materiau
572 For Each i In lst_mat
573 RCcombo1.AddItems(i.nom)
574 RCcombo3.AddItems(i.nom)
575 Next i
576
577 Dim j As sectionPoutre
578 For Each j In lst_Section
579 RCcombo2.AddItems(j.nom)
580 Next j
581 listecree = True
582 End If
583
584 ' on met les bonnes valeurs dans les combobox en fonction de quel type de section est sélectionné
585 Dim nom As String
586 If premier Then nom = lst_Section.Item(1).nom Else nom = RCcombo2.ItemText(RCcombo2.CurrentSelection)
587
588 sec = lst_Section.Item(nom)
589 InfoPoutres(0)
590
591 End Sub
592
593
594
595 Public Sub InfoPoutres(ByVal code As Integer)
596
597 Dim sec As sectionPoutre
598 Dim ContenuCombo As String
599 Dim Ixx As Double, Iyy As Double, Aire As Double
600 ' 1 - trouver quelle section est affichée
601 ContenuCombo = RCcombo2.ItemText(-1)
602
603 ' 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.
604
605 For Each sec In lst_Section
606 If sec.nom = ContenuCombo Then Exit For
607 Next sec
608
609 'Select Case code
610 ' Case 14 ' change la valeur de D1
611 ' Case 16 ' change D2
612 ' Case 18 ' change d3
613 ' Case 20 ' change d4
614 ' Case 22 ' change d5
615 ' Case 24 ' change d6
616 ' Case 10, 12, 31 ' aire ou inertie de changé
617 ' ' on ne fait rien pour l'instant
618 ' Case 0 ' change la section
619
620 If code = 10 Or code = 12 Or code = 31 Then Exit Sub
621
622 If ContenuCombo = " Rectangle générique" Then
623 RCCode.InertieRectangle(RCNumberboxD1.Value, RCNumberboxD2.Value, Aire, Ixx, Iyy)
624 RCNumberbox1.Value = Ixx
625 RCNumberbox2.Value = Iyy
626 LabelD1.Caption = "Longueur D1 "
627 LabelD2.Caption = "Longueur D2 "
628 RCNumberboxD3.Value = 0 : LabelD3.Caption = "Innutile"
629 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
630 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
631 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
632 RCNumberbox5.Value = Aire
633
634
635 ElseIf ContenuCombo = " Poutre en I générique" Then
636 RCCode.InertiePoutreI(RCNumberboxD1.Value, RCNumberboxD2.Value, RCNumberboxD3.Value, RCNumberboxD4.Value, Aire, Ixx, Iyy)
637 RCNumberbox1.Value = Ixx
638 RCNumberbox2.Value = Iyy
639 LabelD1.Caption = "Longueur D1 "
640 LabelD2.Caption = "Longueur D2 "
641 LabelD3.Caption = "Longueur D3 "
642 LabelD4.Caption = "Longueur D4 "
643 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
644 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
645 RCNumberbox5.Value = Aire
646
647 ElseIf ContenuCombo = " Cylindrique (Rod) générique" Then
648 RCCode.InertieCirculairePlein(RCNumberboxD1.Value, Aire, Ixx, Iyy)
649 RCNumberbox1.Value = Ixx
650 RCNumberbox2.Value = Iyy
651 LabelD1.Caption = "Diamètre D1 "
652 RCNumberboxD2.Value = 0 : LabelD2.Caption = "Innutile"
653 RCNumberboxD3.Value = 0 : LabelD3.Caption = "Innutile"
654 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
655 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
656 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
657 RCNumberbox5.Value = Aire
658
659 ElseIf ContenuCombo = " Tuyau (Pipe) générique" Then
660 RCCode.InertiePipe(RCNumberboxD1.Value, RCNumberboxD3.Value, Aire, Ixx, Iyy)
661 RCNumberbox1.Value = Ixx
662 RCNumberbox2.Value = Iyy
663 LabelD1.Caption = "Diamètre D1 "
664 RCNumberboxD2.Value = 0 : LabelD2.Caption = "Innutile"
665 LabelD3.Caption = "Épaisseur "
666 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
667 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
668 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
669 RCNumberbox5.Value = Aire
670
671 ElseIf ContenuCombo = " Tube carré générique" Then
672 RCCode.InertieTube(RCNumberboxD1.Value, RCNumberboxD2.Value, RCNumberboxD3.Value, Aire, Ixx, Iyy)
673 RCNumberbox1.Value = Ixx
674 RCNumberbox2.Value = Iyy
675 LabelD1.Caption = "Longueur D1 "
676 LabelD2.Caption = "Largeur D2 "
677 LabelD3.Caption = "Épaisseur D3 "
678 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
679 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
680 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
681 RCNumberbox5.Value = Aire
682
683 ElseIf ContenuCombo = " Poutre en C générique" Then
684 RCCode.InertieC(RCNumberboxD1.Value, RCNumberboxD2.Value, RCNumberboxD3.Value, RCNumberboxD4.Value, RCNumberboxD5.Value, Aire, Ixx, Iyy)
685 RCNumberbox1.Value = Ixx
686 RCNumberbox2.Value = Iyy
687 LabelD1.Caption = "Longueur D1 "
688 LabelD2.Caption = "Largeur D2 "
689 LabelD3.Caption = "Épaisseur D3 "
690 LabelD4.Caption = "Épaisseur D4 "
691 LabelD5.Caption = "Distance D5 "
692 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
693 RCNumberbox5.Value = Aire
694
695 ElseIf ContenuCombo = " Poutre en L générique" Then
696 RCCode.InertieL(RCNumberboxD1.Value, RCNumberboxD2.Value, RCNumberboxD3.Value, RCNumberboxD4.Value, RCNumberboxD5.Value, RCNumberboxD6.Value, Aire, Ixx, Iyy)
697 RCNumberbox1.Value = Ixx
698 RCNumberbox2.Value = Iyy
699 LabelD1.Caption = "Longueur D1 "
700 LabelD2.Caption = "Largeur D2 "
701 LabelD3.Caption = "Épaisseur D3 "
702 LabelD4.Caption = "Épaisseur D4 "
703 LabelD5.Caption = "Distance D5 "
704 LabelD6.Caption = "Distance D6 "
705 RCNumberbox5.Value = Aire
706
707
708 ElseIf ContenuCombo = " Poutre en T générique" Then
709 RCCode.InertieT(RCNumberboxD1.Value, RCNumberboxD2.Value, RCNumberboxD3.Value, RCNumberboxD4.Value, RCNumberboxD5.Value, Aire, Ixx, Iyy)
710 RCNumberbox1.Value = Ixx
711 RCNumberbox2.Value = Iyy
712 LabelD1.Caption = "Longueur D1 "
713 LabelD2.Caption = "Largeur D2 "
714 LabelD3.Caption = "Épaisseur D3 "
715 LabelD4.Caption = "Épaisseur D4 "
716 LabelD5.Caption = "Distance D5 "
717 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile "
718 RCNumberbox5.Value = Aire
719
720 ElseIf Left(ContenuCombo, 2) = "ST" Then ' tube carré troué
721 RCNumberbox1.Value = sec.I1
722 RCNumberbox2.Value = sec.I2
723 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 "
724 RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Largeur D2 "
725 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Épaisseur D3 "
726 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
727 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
728 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
729 RCNumberbox5.Value = sec.Aire
730
731 ElseIf Left(ContenuCombo, 1) = "S" Then ' poutre en I de type S
732 RCNumberbox1.Value = sec.I1
733 RCNumberbox2.Value = sec.I2
734 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 "
735 RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Longueur D2 "
736 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Longueur D3 "
737 RCNumberboxD4.Value = sec.D4 : LabelD4.Caption = "Longueur D4 "
738 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
739 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
740 RCNumberbox5.Value = sec.Aire
741
742 ElseIf Left(ContenuCombo, 4) = "Tube" Then ' le tube rond
743 RCNumberbox1.Value = sec.I1
744 RCNumberbox2.Value = sec.I2
745 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Diamètre D1 "
746 RCNumberboxD2.Value = 0 : LabelD2.Caption = "Innutile"
747 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Épaisseur "
748 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
749 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
750 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
751 RCNumberbox5.Value = sec.Aire
752 ElseIf Left(ContenuCombo, 2) = "Cy" Then ' circulaire Plein
753 RCNumberbox1.Value = sec.I1
754 RCNumberbox2.Value = sec.I2
755 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Diamètre D1 "
756 RCNumberboxD2.Value = 0 : LabelD2.Caption = "Innutile"
757 RCNumberboxD3.Value = 0 : LabelD3.Caption = "Innutile"
758 RCNumberboxD4.Value = 0 : LabelD4.Caption = "Innutile"
759 RCNumberboxD5.Value = 0 : LabelD5.Caption = "Innutile"
760 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
761 RCNumberbox5.Value = sec.Aire
762 ElseIf Left(ContenuCombo, 1) = "C" Then ' le channel
763 RCNumberbox1.Value = sec.I1
764 RCNumberbox2.Value = sec.I2
765 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 "
766 RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Largeur D2 "
767 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Épaisseur D3 "
768 RCNumberboxD4.Value = sec.D4 : LabelD4.Caption = "Épaisseur D4 "
769 RCNumberboxD5.Value = sec.D5 : LabelD5.Caption = "Distance D5 "
770 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile"
771 RCNumberbox5.Value = sec.Aire
772 ElseIf Left(ContenuCombo, 1) = "L" Then ' l'Angle en L
773 RCNumberbox1.Value = Ixx
774 RCNumberbox2.Value = Iyy
775 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 "
776 RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Largeur D2 "
777 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Épaisseur D3 "
778 RCNumberboxD4.Value = sec.D4 : LabelD4.Caption = "Épaisseur D4 "
779 RCNumberboxD5.Value = sec.D5 : LabelD5.Caption = "Distance D5 "
780 RCNumberboxD6.Value = sec.D6 : LabelD6.Caption = "Distance D6 "
781 RCNumberbox5.Value = Aire
782 ElseIf Left(ContenuCombo, 1) = "T" Then ' le T
783 RCNumberbox1.Value = sec.I1
784 RCNumberbox2.Value = sec.I2
785 RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 "
786 RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Largeur D2 "
787 RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Épaisseur D3 "
788 RCNumberboxD4.Value = sec.D4 : LabelD4.Caption = "Épaisseur D4 "
789 RCNumberboxD5.Value = sec.D5 : LabelD5.Caption = "Distance D5 "
790 RCNumberboxD6.Value = 0 : LabelD6.Caption = "Innutile "
791 RCNumberbox5.Value = sec.Aire
792
793
794 Else
795 'MsgBox("Le Else est activé dans InfoPoutres, c'est anormal, le type de section n'est pas reconnu!")
796 End If
797
798 'End Select
799
800
801 'RCNumberbox1.Value = sec.I1
802 'RCNumberbox2.Value = sec.I2
803 'RCNumberboxD1.Value = sec.D1 : LabelD1.Caption = "Longueur D1 [m]"
804 'RCNumberboxD2.Value = sec.D2 : LabelD2.Caption = "Longueur D2 [m]"
805 'RCNumberboxD3.Value = sec.D3 : LabelD3.Caption = "Longueur D3 [m]"
806 'RCNumberboxD4.Value = sec.D4 : LabelD4.Caption = "Longueur D4 [m]"
807 'RCNumberboxD5.Value = sec.D5 : LabelD5.Caption = "Longueur D5 [m]"
808 'RCNumberboxD6.Value = sec.D6 : LabelD6.Caption = "Longueur D6 [m]"
809 'RCNumberbox5.Value = sec.Aire
810
811 End Sub
812
813
814 Public Function CreationAttributPourPoutre(ByRef swEnt As SldWorks.Entity, ByRef N3 As String, Optional ByRef miniPoutre As Boolean = False) As Boolean
815
816 Dim nom As String
817 Dim no As Long 'Static no As Long
818 Dim swArete As SldWorks.Edge
819
820 If miniPoutre Then no = Intersections.nbMinipoutre Else no = CLng(Right(N3, Len(N3) - 7))
821
822 swArete = swEnt
823 If miniPoutre Then nom = "MiniPoutre" & CStr(no) Else nom = "RCPoutre" & CStr(no)
824 Dim Attr As SldWorks.Attribute = Nothing
825
826 Try
827 Attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0) ' si l'attribut existe déjà on pointe dessus.
828 'Dim p As SldWorks.Parameter
829 '
830 'p = Attr.GetParameter("D1")
831 'MsgBox("La valeur de D1 est:" & p.GetDoubleValue)
832 Catch ex As Exception
833 'MsgBox("N'arrive pas à se lier à l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
834 End Try
835
836 If Attr Is Nothing Then Attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, swArete, nom, 0, 2) ' 0 = swThisconfig
837
838 While Attr Is Nothing
839 no += 1
840 compteur += 1
841 If miniPoutre Then nom = "MiniPoutre" & CStr(no) Else nom = "RCPoutre" & CStr(no)
842 Attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, swArete, nom, 0, 0)
843 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")
844
845 End While
846
847 Intersections.nbMinipoutre = no
848
849 Dim swAreteP As SldWorks.Edge
850 swAreteP = swEnt
851 'slyPoutre = trouver(swAreteP, Commun.tipe_e.poutre)
852 'slyPoutre.swAttribute = Attr
853
854 Dim ParamM As SldWorks.Parameter
855 Dim ParamS As SldWorks.Parameter
856 Dim ParamI1 As SldWorks.Parameter
857 Dim ParamI2 As SldWorks.Parameter
858 Dim ParamD1 As SldWorks.Parameter
859 Dim ParamD2 As SldWorks.Parameter
860 Dim ParamD3 As SldWorks.Parameter
861 Dim ParamD4 As SldWorks.Parameter
862 Dim ParamD5 As SldWorks.Parameter
863 Dim ParamD6 As SldWorks.Parameter
864 Dim ParamAs As SldWorks.Parameter
865 Dim ParamFlag As SldWorks.Parameter
866 Dim ParamN3 As SldWorks.Parameter = Nothing
867
868 ParamM = Attr.GetParameter("M")
869 ParamS = Attr.GetParameter("S")
870 ParamI1 = Attr.GetParameter("I1")
871 ParamI2 = Attr.GetParameter("I2")
872 ParamD1 = Attr.GetParameter("D1")
873 ParamD2 = Attr.GetParameter("D2")
874 ParamD3 = Attr.GetParameter("D3")
875 ParamD4 = Attr.GetParameter("D4")
876 ParamD5 = Attr.GetParameter("D5")
877 ParamD6 = Attr.GetParameter("D6")
878 ParamAs = Attr.GetParameter("As")
879 ParamFlag = Attr.GetParameter("Flag")
880
881 If Not miniPoutre Then ParamN3 = Attr.GetParameter("N3")
882
883
884
885 ' maintenant on place les valeurs.
886 ' Paramètre m:
887 'Dim m As String
888 'Dim s As String
889 'Dim I1 As Double
890 'Dim I2 As Double
891 'Dim D1 As Double
892 'Dim D2 As Double
893 'Dim D3 As Double
894 'Dim D4 As Double
895 'Dim D5 As Double
896 'Dim D6 As Double
897 'Dim As1 As Double
898 'Dim Flag As Double
899 'If Not miniPoutre Then
900 ' m = RCcombo1.ItemText(RCcombo1.CurrentSelection)
901 ' s = RCcombo2.ItemText(RCcombo2.CurrentSelection)
902 ' I1 = RCNumberbox1.Value
903 ' 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
904 ' I2 = RCNumberbox2.Value
905 ' 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
906 ' D1 = RCNumberboxD1.Value
907 ' 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
908 ' D2 = RCNumberboxD2.Value
909 ' 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
910
911 ' D3 = RCNumberboxD3.Value
912 ' 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
913 ' D4 = RCNumberboxD4.Value
914 ' 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
915 ' D5 = RCNumberboxD5.Value
916 ' 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
917 ' D6 = RCNumberboxD6.Value
918 ' 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
919
920 ' As1 = RCNumberbox5.Value
921 ' 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
922
923 ' If RCCode.FaceDeSectionPoutre = True Then Flag = 1 Else Flag = 0
924
925
926 'Else
927 ' 'mettre ici les valeurs pour les mini-poutres
928 ' m = "Materiau"
929 ' s = "Section"
930 ' I1 = 22
931 ' I2 = 22
932 ' D1 = 22
933 ' D2 = 22
934 ' As1 = 22
935 ' Flag = 0
936 'End If
937 If FaceDeSectionPoutre = True Then Flag = 1 Else Flag = 0
938 If miniPoutre = True Then As1 = -7
939 ParamM.SetStringValue2(m, 2, "") ' swAllConfiguration = 2
940 ParamS.SetStringValue2(s, 2, "")
941 ParamI1.SetDoubleValue2(I1, 2, "")
942 ParamI2.SetDoubleValue2(I2, 2, "")
943 If I1 > Commun.Imax Then Imax = I1 ' mettre la valeur maximale de IMax pour les mini-poutres infinies...
944 If I2 > Commun.Imax Then Imax = I2
945 ParamD1.SetDoubleValue2(D1, 2, "")
946 ParamD2.SetDoubleValue2(D2, 2, "")
947 ParamD3.SetDoubleValue2(D3, 2, "")
948 ParamD4.SetDoubleValue2(D4, 2, "")
949 ParamD5.SetDoubleValue2(D5, 2, "")
950 ParamD6.SetDoubleValue2(D6, 2, "")
951 ParamAs.SetDoubleValue2(As1, 2, "")
952 ParamFlag.SetDoubleValue2(Flag, 2, "")
953
954 If As1 < Commun.Amax Then Commun.Amax = As1
955 If Not miniPoutre Then ParamN3.SetStringValue2(N3, 2, "")
956
957
958 'swModel.Extension.SelectByID2(nom, "ATTRIBUTE", 0, 0, 0, False, 0, Nothing, 0)
959
960 'Try
961 'swModel.EditRebuild3()
962 'Dim swFeat As sldworks.Feature = swModel.FeatureByPositionReverse(0)
963 'Dim chaine As String
964 'chaine = "Section = " & CStr(s) & vbCr & "Ixx = " & Format(I1, "0.000E+00") & " m^4" & vbCr & "Iyy = " & Format(I2, "0.000E+00") & " m^4" & vbCr & "Aire section = " & Format(As1, "0.000E+00") & " m^2" & vbCr & "D1 = " & Format(D1, "0.000E+00") & " m" & vbCr & "D2 = " & Format(D2, "0.000E+00") & " m" & vbCr & "D3 = " & Format(D3, "0.000E+00") & " m" & vbCr & "D4 = " & Format(D4, "0.000E+00") & " m" & vbCr & "D5 = " & Format(D5, "0.000E+00") & " m" & vbCr & "D6 = " & Format(D6, "0.000E+00") & " m"
965 'Debug.Print(chaine)
966 'swFeat.AddComment(chaine)
967 'Catch ex As Exception
968
969 'End Try
970
971 GererDossiers("Poutres", nom)
972
973
974 If miniPoutre Then swArete.Display(2, 1, 0, 1, True) Else swArete.Display(2, 0, 1, 0, True) ' mini-poutre = violet, poutre = vert
975
976
977 Return True
978 End Function
979
980 Private Function GestionAttributCoque() As Boolean
981 Dim swFace As SldWorks.Face2
982 Dim coques As New Collections.Generic.List(Of sldworks.Entity)
983
984 Dim SelMgr As sldworks.SelectionMgr
985 Dim swEnt As SldWorks.Entity
986 SelMgr = swModel.SelectionManager
987
988 If lstSelection3.Count = 0 Then MsgBox("Vous devez sélectionner au moins une face (coque)!", MsgBoxStyle.Critical, "Impossible d'exécuter la commande") : Exit Function
989
990 ' dans les entités sélectionnées il y a des faces.
991
992 'For i = 1 To SelMgr.GetSelectedObjectCount
993 For Each swEnt In lstSelection3
994 'swEnt = SelMgr.GetSelectedObject5(i)
995 swFace = swEnt
996
997 ' on se débarasse des faces qui sont sur un volume
998 Dim corps As sldworks.Body2
999
1000 corps = swFace.GetBody()
1001
1002 If Not corps.GetType = swconst.swBodyType_e.swSolidBody Then
1003 coques.Add(swEnt)
1004 'If Not CreationAttributPourCoque(swEnt) Then GestionAttributCoque = False : Exit Function
1005 Else
1006 MsgBox("Une face sélectionnée appartient à un volume, elle ne sera pas traitée!", MsgBoxStyle.Information, "Une face n'est pas une coque")
1007 End If
1008 Next swEnt
1009
1010 For Each swEnt In coques
1011 CreationAttributPourCoque(swEnt)
1012 Next
1013 Return True
1014
1015 End Function
1016
1017 Public Function CreationAttributPourCoque(ByRef swEnt As SldWorks.Entity, Optional ByRef Epaisseur As Double = -1, Optional ByRef materiau As String = Nothing) As Boolean
1018 Dim nom As String = Nothing
1019 Static no As Long
1020 Dim Flag As Double
1021 Dim swFace As SldWorks.Face2
1022
1023 swFace = swEnt
1024
1025 Dim Attr As SldWorks.Attribute
1026
1027 Try
1028 Attr = swEnt.FindAttribute(DefAttrRCCoque, 0) ' si l'attribut existe déjà on pointe dessus.
1029 Catch ex As Exception
1030 Attr = Nothing
1031 'MsgBox("N'arrive pas à se lier à l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
1032 End Try
1033
1034 Do While Attr Is Nothing
1035 nom = "RCCoque" & CStr(no)
1036 If Attr Is Nothing Then Attr = DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 2) ' 0 = swThisconfig
1037 no = no + 1
1038 Loop
1039 Dim ParamM As SldWorks.Parameter
1040 Dim ParamEp As SldWorks.Parameter
1041 Dim ParamFlag As SldWorks.Parameter
1042
1043 ParamM = Attr.GetParameter("M")
1044 ParamEp = Attr.GetParameter("Ep")
1045 ParamFlag = Attr.GetParameter("Flag")
1046
1047 ' maintenant on place les valeurs.
1048 ' Paramètre m:
1049 'If materiau Is Nothing Then materiau = RCcombo1.ItemText(RCcombo3.CurrentSelection)
1050 If Epaisseur = -1 Then Epaisseur = ModEpaisseur 'RCNumberbox6.Value '
1051 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
1052 If RCCode.RCCheckFacedeSectionCoque.Checked = True Then Flag = 1 Else Flag = 0
1053 If FaceDeSectionCoque Then Flag = 1 Else Flag = 0
1054
1055 ParamM.SetStringValue2(materiau, 2, "") ' swAllConfiguration = 2
1056 ParamEp.SetDoubleValue2(Epaisseur, 2, "")
1057 ParamFlag.SetDoubleValue2(Flag, 2, "")
1058
1059
1060 Try
1061 swModel.EditRebuild3()
1062 Dim swFeat As sldworks.Feature = swModel.FeatureByPositionReverse(0)
1063 Dim chaine As String
1064 chaine = "Épaisseur = " & Format(Epaisseur, "0.00000") & " m" & vbCr & "Flag (pour débug) " & Format(Flag, "0")
1065 swFeat.AddComment(chaine)
1066 Catch ex As Exception
1067
1068 End Try
1069
1070 GererDossiers("Coques", nom)
1071
1072
1073 CreationAttributPourCoque = True
1074 End Function
1075
1076 Public Sub LectureRC()
1077 ' procédure qui redonne à l'utilisateur les informations concernant les attributs sélectionnés.
1078 ' il y a un feature de sélectionné, ou une poutre.
1079 Dim deb As New Debug_form
1080 deb.Show()
1081
1082
1083 End Sub
1084
1085 Private Sub InertieRectangle(ByVal d1 As Double, ByVal d2 As Double, ByRef aire As Double, ByRef Ixx As Double, ByRef Iyy As Double)
1086 aire = d1 * d2
1087 Iyy = d1 * d2 * d2 * d2 / 12
1088 Ixx = d1 * d1 * d1 * d2 / 12
1089 End Sub
1090
1091 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)
1092 Dim temp As Double
1093 temp = d1 / 2 - d3
1094 aire = (d2 * d3 + d4 * temp) * 2
1095 Ixx = ((d2 * d3 ^ 3 / 12) + (d3 * d2 * (d1 / 2 - d3 / 2) ^ 2) * 2 + (d4 * (d1 - 2 * d3) ^ 3) / 12) '/ 0.0000004162364471
1096 Iyy = (((d3 * d2 ^ 3) / 12) * 2 + (d1 - 2 * d3) * d4 ^ 3 / 12)
1097 End Sub
1098
1099 Private Sub InertieCirculairePlein(ByVal d1 As Double, ByRef aire As Double, ByRef Ixx As Double, ByRef Iyy As Double)
1100 aire = Pi * (d1 / 2 ^ 2)
1101 Ixx = Pi * d1 ^ 4 / 64
1102 Iyy = Ixx
1103 End Sub
1104
1105 Private Sub InertiePipe(ByVal d1 As Double, ByVal d3 As Double, ByRef aire As Double, ByRef Ixx As Double, ByRef Iyy As Double)
1106 aire = Pi * (d1 / 2 ^ 2) - Pi * (d1 / 2 - d3) ^ 2
1107 Ixx = Pi * d1 ^ 4 / 64
1108 Iyy = Ixx
1109 End Sub
1110
1111 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)
1112 Dim b1 As Double, b2 As Double
1113 b1 = d1 - 2 * d3 : b2 = d2 - 2 * d3
1114 aire = (d1 * d2) - ((b1) * (b2))
1115 Ixx = (d2 * d1 ^ 3 / 12) - (b2 * b1 ^ 3 / 12)
1116 Iyy = (d1 * d2 ^ 3 / 12) - (b1 * b2 ^ 3 / 12)
1117 End Sub
1118
1119 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)
1120 Dim a As Double, b As Double
1121 a = d5 + d4 - d2 / 2
1122 b = d5 + d4 / 2
1123
1124 aire = d4 * (d1 - 2 * d3) + (d2 * d3) * 2
1125 Ixx = (d2 * d3 ^ 3 / 12 + d2 * d3 * (d1 / 2 - d3 / 2) ^ 2) * 2 + d4 * (d1 - 2 * d3) ^ 3
1126 Iyy = ((d1 - 2 * d3) * d4 ^ 3 / 12 + (d1 - 2 * d3) * d4 * b ^ 2) + (d3 * d2 ^ 3 / 12 + d3 * d2 * a ^ 2) * 2
1127 End Sub
1128
1129 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)
1130 aire = d3 * d2 + d4 * (d1 - d3)
1131 Ixx = d2 * d3 ^ 3 / 12 + (d2 - d3) * (d5 - d3 / 2) ^ 2 + d4 * (d1 - d3) ^ 3 / 12 + d4 * (d1 - d3) * ((d1 - d3) / 2 - d5) ^ 2
1132 Iyy = d3 * d2 ^ 3 / 12 + d3 * d2 * (d2 / 2 - d6) ^ 2 + (d1 - d3) * d4 ^ 3 / 12 + (d1 - d3) * d4 * (d6 - d4 / 2) ^ 2
1133 End Sub
1134
1135 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)
1136 aire = d2 * d3 + (d1 - d3) * d4
1137 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
1138 Iyy = d3 * d2 ^ 3 / 12 + (d1 - d3) * d4 ^ 3 / 12
1139 End Sub
1140
1141
1142
1143 End Module
1144
1145 End Namespace