ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SlyFaceCoque.vb
Revision: 46
Committed: Wed Aug 22 18:28:53 2007 UTC (18 years ago) by bournival
File size: 13563 byte(s)
Log Message:
Ajout de la page de pré-optimisation automatique et des modification que j'ai apportées.

File Contents

# Content
1 Public Class SlyFaceCoque
2 Inherits SuperFace
3
4
5 Private epaisseur As Double
6 Public materiau As Long
7 Public swAttribute As SldWorks.Attribute ' l'attribut qui contient l'épaisseur. et le matériau
8
9 Private FlagFace_de_section As Integer = 99
10
11 Sub New(ByRef swface As SldWorks.Face2)
12 MyBase.New(swface, 1) ' 1 car c'est une coque
13 End Sub
14
15 Protected Overrides Sub Finalize()
16 Me.lst_Faces.Clear()
17 Me.lst_InterPoutre.Clear()
18 Me.lst_InterCoqueVolume.Clear()
19 MyBase.Finalize()
20 End Sub
21
22
23 ''' <summary>
24 ''' sub qui CRÉÉ une instance de la classe InterPoutreCoque si et seulement si il n'en existe pas avant. S'il en existe alors on update la classe déjà existante.
25 ''' </summary>
26 ''' <param name="sPoutre">La SlyPoutre</param>
27 ''' <param name="xyz1">Laposition du pount d'intersection</param>
28 ''' <param name="tipe">=1 si on découpe en X, 2 si à l'intérieur, 3 si à l'extérieur</param>
29 ''' <returns>La classe d'intersection</returns>
30 ''' <remarks>dans tous les cas on retourne la classe (pour pouvoir l'ajouter à la poutre...)</remarks>
31 Public Function AjouterInterPoutre(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterPoutreCoque
32
33 Dim int As InterPoutreCoque
34
35 For Each int In lst_InterPoutre
36 If Math.Abs(int.x - xyz1(0)) < Epsilon And Math.Abs(int.y - xyz1(1)) < Epsilon And Math.Abs(int.z - xyz1(2)) < Epsilon Then
37 ' on a un point déjà existant,
38 int.lst_sPoutre.Add(sPoutre)
39 int.lst_type.Add(tipe)
40 Return int
41 End If
42 Next
43
44
45 ' si on est ici c'est que l'on doit créer l'intersection
46 int = New InterPoutreCoque
47
48 int.x = xyz1(0)
49 int.y = xyz1(1)
50 int.z = xyz1(2)
51
52 int.lst_sPoutre.Add(sPoutre)
53 int.lst_type.Add(tipe)
54 int.sFaceCoque = Me
55 lst_InterPoutre.Add(int)
56 Return int
57
58 End Function
59
60
61
62
63 Public Function PossedeFaceDeSection() As Boolean
64
65 If Not Me.FlagFace_de_section = 99 Then Return CBool(Me.FlagFace_de_section)
66 Dim retour As Double
67
68 Dim p As SldWorks.Parameter
69 Try
70 p = swAttribute.GetParameter("Flag")
71 Catch ex As Exception
72 MsgBox("N'arrive pas à se lier à l'attribut pour obtenir la largeur, la poutre n'a peut-être pas d'attributs...")
73 Return Nothing
74 End Try
75
76 retour = p.GetDoubleValue
77 Me.FlagFace_de_section = retour
78 If retour = 1 Then Return True Else Return False
79
80 End Function
81
82
83 ''' <summary>
84 ''' Donne l'épaisseur de la coque
85 ''' </summary>
86 ''' <value></value>
87 ''' <returns></returns>
88 ''' <remarks></remarks>
89 Public ReadOnly Property GetEpaisseur() As Double
90 Get
91 If Not Me.epaisseur = 0 Then Return Me.epaisseur : Exit Property ' pour optimiser
92
93
94 Dim p As SldWorks.Parameter
95
96 Try
97 p = swAttribute.GetParameter("Ep")
98 Catch ex As Exception
99 MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'épaisseur, la coque n'a peut-être pas d'attributs...")
100 Return 0
101 End Try
102
103 Me.epaisseur = p.GetDoubleValue
104 Return p.GetDoubleValue
105 End Get
106 End Property
107
108
109
110 Public Function GetMateriau() As String
111 If Not Me.materiau Then Return Me.materiau : Exit Function ' pour optimiser
112
113
114 Dim p As SldWorks.Parameter = Nothing
115
116 Try
117 p = swAttribute.GetParameter("M")
118 Catch ex As Exception
119 MsgBox("N'arrive pas à se lier à l'attribut pour obtenir le matériau, la coque n'a peut-être pas d'attributs...")
120 End Try
121 Me.materiau = p.GetStringValue
122 Return p.GetStringValue
123 End Function
124
125 Public Function GetAttribute() As SldWorks.Attribute
126 Dim ent As SldWorks.Entity
127 Dim attr As SldWorks.Attribute = Nothing
128
129 Try
130 ent = lst_Faces.Item(1)
131 attr = ent.FindAttribute(Intersections.DefAttrRCCoque, 0)
132 Me.swAttribute = attr
133 Catch ex As Exception
134 MsgBox("ERREUR! Une coque sans attributs !", MsgBoxStyle.Critical)
135 End Try
136 If IsNothing(attr) Then ' on a trouvé un attribut de coque
137 MsgBox("Une coque sans attributs !")
138 End If
139 Return attr
140 End Function
141
142 Private Function PointInterne(ByRef P1() As Double, ByRef P2() As Double, ByRef centreX As Double, ByRef centreY As Double) As Double()
143 Dim b(1) As Double
144 Dim c(1) As Double
145 Dim d(1) As Double
146 b(0) = P1(0) - centreX
147 b(1) = P1(1) - centreY
148 c(0) = P1(0) - centreX
149 c(1) = P1(1) - centreY
150
151 b = Outils_Math.unitaire(b)
152 c = Outils_Math.unitaire(c)
153
154 d(0) = ((b(0) + c(0)) / 2) * 50 * Epsilon
155 d(1) = ((b(0) + c(0)) / 2) * 50 * Epsilon
156
157 Return d
158
159 End Function
160
161 ' cette sub ajoute LES constantes de la coque aux nom de l'entité.
162 Public Sub AddConstantes()
163 ' cette sub ajoute LES constantes de la coque aux nom de l'entité.
164 ' on suppose qu'il n'y en a pas déjà
165 ' tout ce que j'ai à faire c'est de modifier la propriété nom.
166
167 'Format(valeur, "0.00000e+000")
168 Dim epaisseur As Double
169
170
171 epaisseur = Me.GetEpaisseur()
172 If epaisseur <= 0 Then
173 MsgBox("Attention, une coque n'a pas d'épaisseur ou une épaisseur négative, celle-ci est affichée en rouge sur le modèle découpé. Une valeur de 1 a été utilisée par défaut")
174 epaisseur = 1
175 Dim ent As SldWorks.Entity
176 ent = Me.swFace : ent.Select4(False, Nothing)
177 swModel.SelectedFaceProperties(1, 0, 0, 0, 0, 0, 0, False, "")
178 End If
179
180
181 nom = nom & "¢" & Format(epaisseur, "0.00000e+000") & "MA" & Format(materiau, "00")
182
183 ' attention, s'il y a une intersection, je dois la noter et l'ajouter au nom....
184 Dim c As Integer
185 For c = 1 To Len(nom)
186 If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
187 Next c
188 End Sub
189
190
191
192 Friend Overrides Function UpdateApresSplit(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre, ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef Plan As SldWorks.RefPlane, Optional ByRef FI As Boolean = False) As SldWorks.Face2
193
194 ' le pointeur Me.swFace pointe soit sur une face, soit sur la face originale soit la face découpée
195 ' cette procédure doit créer une nouvelle SlyFaceCoque
196 ' et tout ce que j'ai c'est un pointeur, et je sais même pas lequel.
197 ' la fonction ne créée pas de nouvelles slyEntités.
198 ' si le découpage donne 3 faces ou plus, elles sont placées dans lst_AutreFaces
199
200
201 ' 1 - on obtient les 2 nouvelles faces,
202 Dim vFace As Object
203 Dim Face1 As SldWorks.Face2
204 Dim Face2 As SldWorks.Face2
205 Dim FaceInterne As SldWorks.Face2
206 Dim FaceExterne As SldWorks.Face2
207 Dim swFeat As SldWorks.Feature
208
209 swFeat = swModel.FeatureByPositionReverse(0)
210 vFace = swFeat.GetFaces
211
212 If vFace Is Nothing Then Return Nothing ' le code nothing veut dire que la face n'a pas été coupée.
213
214 Face1 = vFace(0)
215 Face2 = vFace(1)
216
217 Try ' vérification
218 Dim face3 As SldWorks.Face2
219 Dim i As Integer
220 'Dim slyFaceSupplémentaire As SlyFaceCoque ' la raison du pourquoi on doit avoir 2 sous-routines
221
222 For i = 2 To 1000
223 face3 = vFace(i)
224 Me.lst_Faces.Add(face3)
225 Next i
226
227 'MsgBox("Problème, on a au moins 3 face dans le update après le découpage", MsgBoxStyle.Critical)
228 Catch ex As Exception
229 ' tout est normal...
230 End Try
231
232 ' SECRET 1.999 ' c'est pas scientifique mais ça peut marcher
233 If Math.Abs(Face1.GetArea) > Math.Abs(10 * Face2.GetArea) Then
234 FaceInterne = Face2
235 FaceExterne = Face1
236 ElseIf Math.Abs(Face1.GetArea) < Math.Abs(10 * Face2.GetArea) Then
237 FaceInterne = Face1
238 FaceExterne = Face2
239 Else
240
241
242 '' 2 - on a un point, on trouve quelle face est la plus proche.
243 If Commun.Distance(Face1, x, y, z) < Commun.Distance(Face2, x, y, z) Then
244 FaceInterne = Face1
245 FaceExterne = Face2
246 Else
247 FaceInterne = Face2
248 FaceExterne = Face1
249 End If
250 End If
251
252 Me.lst_Faces.Add(FaceInterne)
253 Me.lst_Faces.Add(FaceExterne)
254
255 '' 3 - on créé une nouvelle coque (intérieure) et on lui donne les propriétés originales et on met dans la liste des coques
256 'Me.swFace = FaceExterne
257 Dim aire As Double
258 aire = FaceExterne.GetArea
259
260 ' ************************************************
261 ' pour placer un attribut sur la face interne
262 Dim attr As SldWorks.Attribute
263 Dim swent As SldWorks.Entity
264 Static no As Integer
265
266 If FI Then
267 Dim nom2 As String = "FaceInterne" & no
268
269 swent = FaceInterne
270 attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
271
272 If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
273
274 While attr Is Nothing
275 no += 1
276 nom2 = "FaceInterne" & CStr(no)
277 attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
278 End While
279 GererDossiers("FaceInternes", nom2)
280 no += 1
281 ElseIf Flag = 2 Then ' on a un channel, on fait les 2 options
282 Dim nom2 As String = "FaceInterne" & no
283
284 swent = FaceInterne
285 attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
286
287 If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
288
289 While attr Is Nothing
290 no += 1
291 nom2 = "FaceInterne" & CStr(no)
292 attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
293 End While
294 GererDossiers("FaceInternes", nom2)
295 no += 1
296 MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
297 Else
298 MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
299 End If
300
301 ' ************ l'attribut de la condition aux limites *******************
302 'attr = Nothing
303 'Dim nom3 As String
304 'Dim p As SldWorks.Parameter
305 'If Not Me.condition = "" Then
306 ' nom3 = "CLc_" & no & "_" & Me.nom & " " & Me.condition
307 ' attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
308
309 ' While attr Is Nothing
310 ' If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, FaceInterne, nom3, 0, 0)
311 ' If attr Is Nothing Then nom3 = nom3 & CStr(Timer)
312 ' End While
313
314 ' p = attr.GetParameter("CL")
315 ' p.SetStringValue(Me.condition)
316
317 'End If
318 ' GererDossiers("Conditions Aux Limites", nom3)
319 ' *****************************************************
320 Return FaceInterne
321
322
323 End Function
324
325 Public Sub SetAttributDeCoque(ByRef epaisseur As Double, Optional ByRef materiau As String = Nothing)
326 Dim nom As String
327 Dim swFace As SldWorks.Face2
328 Dim swent As SldWorks.Entity
329 Dim no As Long
330 Dim Attr As SldWorks.Attribute
331
332 swFace = Me.SwFace
333 swent = swFace
334
335
336 Try
337 Attr = swent.FindAttribute(Intersections.DefAttrRCCoque, 0) ' si l'attribut existe déjà on pointe dessus.
338 Catch ex As Exception
339 'MsgBox("N'arrive pas à se lier à l'attribut!", MsgBoxStyle.Information, "SetAttributsDePoutre")
340 Exit Sub
341 End Try
342
343 If Attr Is Nothing Then Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 2) ' 0 = swThisconfig
344
345 While Attr Is Nothing
346 no += 1
347 nom = "RCCoque" & CStr(no)
348 Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 0)
349 If no > 100000 Then MsgBox("N'arrive pas à créer l'attribut sur la coque après 100 000 essais...", MsgBoxStyle.Exclamation, "Problème dans CreationAttributPourPoutre")
350
351 End While
352
353
354 Dim ParamM As SldWorks.Parameter
355 Dim ParamEp As SldWorks.Parameter
356
357 ParamM = Attr.GetParameter("M")
358 ParamEp = Attr.GetParameter("Ep")
359
360 If materiau IsNot Nothing Then ParamM.SetStringValue2(materiau, 2, "") ' swAllConfiguration = 2
361 ParamEp.SetStringValue2(epaisseur, 2, "")
362
363 End Sub
364
365
366 End Class
367