ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SlyFaceCoque.vb
Revision: 48
Committed: Wed Aug 22 21:18:12 2007 UTC (18 years ago) by bournival
File size: 13668 byte(s)
Log Message:
On passe aux nouveaux .dll

File Contents

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