ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SlyFaceVolume.vb
Revision: 130
Committed: Wed Jul 30 21:26:03 2008 UTC (16 years, 10 months ago) by bournival
File size: 19426 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 Public Class SlyFaceVolume
6 Inherits SuperFace
7
8
9 Sub New(ByVal swface As sldworks.Face2)
10 MyBase.New(swface)
11 End Sub
12
13
14
15 Public Overrides Sub decouper()
16
17 If lst_InterPoutre.Count = 0 Then Exit Sub ' sortir si on a pas d'intersection
18
19
20 ' les attributs ne sont pas updatés sur les faces (mais sur les arètes et les sommets c'est OK)
21 ' on mémorise l'attribut de la face et on la réapplique à la fin.
22
23
24 Dim i As Integer
25 Dim inter As InterPoutreVolume
26 Dim nb1 As Integer, nb2 As Integer, nb3 As Integer, nb5 As Integer
27 Dim poutre1 As SlyAretePoutre = Nothing, poutre3 As SlyAretePoutre = Nothing
28 Dim lst_poutre2 As New Collection
29 Dim aire As Double
30 Dim poutreTest As SlyAretePoutre
31
32 Dim lst_coupeXinter As New Collection
33 Dim lst_coupeXPoutre As New Collection
34 Dim lst_coupeLinter As New Collections.Generic.List(Of InterPoutreVolume)
35 Dim lst_coupeLPoutre As New Collection
36 Dim lst_coupeCinter As New Collection
37 Dim lst_coupeCPoutre As New Collection
38
39
40 For Each inter In lst_InterPoutre
41 'MsgBox("On découpe l'intersection # " & inter.Numero)
42 'pour chaque intersection on peut avoir plusieurs poutres...
43 For i = 1 To inter.lst_sPoutre.Count
44 poutreTest = inter.lst_sPoutre.Item(i)
45 Select Case CInt(inter.lst_type.Item(i))
46 Case 1
47 If poutreTest.GetAireCarree > aire Then poutre1 = poutreTest
48 nb1 += 1
49 Case 2
50 lst_poutre2.Add(poutreTest)
51 nb2 += 1
52 Case 3
53 If poutreTest.GetAireCarree > aire Then poutre3 = poutreTest
54 nb3 += 1
55 Case 5 ' un poutre à faceDeSection
56 nb5 += 1
57 Case 6
58 MsgBox("Une extrémité de la poutre est avec un «Guide» alors que l'autre coté ne l'est pas. Ceci n'est pas programmé...")
59
60 Case 22
61 ' on fait rien, mais c'est pour éviter le msgbox du case else...
62 Case Else
63 MsgBox("Problème dans découper de SlyFaceCoque, le type d'intersection n'est pas reconnu", MsgBoxStyle.Critical)
64 End Select
65 Next i
66
67
68
69 If nb1 > 0 Then 'CoupeX(inter, poutre1) ' on coupe le x en premier
70 lst_coupeXinter.Add(inter)
71 lst_coupeXPoutre.Add(poutre1)
72 End If
73
74
75 For Each poutreTest In lst_poutre2 ' puis on coupe sur la longueur 'CoupeLong(inter, poutreTest)
76 lst_coupeLinter.Add(inter)
77 lst_coupeLPoutre.Add(poutreTest)
78 Next
79
80 If nb3 > 0 Then 'CoupeCote(inter, poutre3) ' finalement on coupe sur les cotés
81 lst_coupeCinter.Add(inter)
82 lst_coupeCPoutre.Add(poutre3)
83 End If
84
85 If nb5 = 1 And (nb1 > 0 Or nb2 > 0 Or nb3 > 0) Then
86 MsgBox("Problème, on a un type d'intersection impossible dans la vraie vie!", MsgBoxStyle.Exclamation, "Design impossible à obtenir en réalité...")
87 End If
88
89
90 lst_poutre2.Clear()
91 nb1 = 0 : nb2 = 0 : nb3 = 0
92
93
94 Next inter
95
96
97 ' maintenant on a toutes les lists d'intersections. On les coupe.
98 For i = 1 To lst_coupeXinter.Count
99 CoupeX(lst_coupeXinter.Item(i), lst_coupeXPoutre.Item(i))
100 Next
101
102 For Each int As InterPoutreVolume In lst_coupeLinter ' i = 1 To lst_coupeLinter.Count
103 int.DecouperLong() 'CoupeLong(lst_coupeLinter.Item(i), lst_coupeLPoutre.Item(i))
104 Next
105
106 ' ne devrait pas avoir desoin de ça avec un volume
107 'For i = 1 To lst_coupeCinter.Count
108 ' CoupeCote(lst_coupeCinter.Item(i), lst_coupeCPoutre.Item(i))
109 'Next
110
111 If nb5 = 1 Then
112 If lst_InterPoutre.Count <> 1 Then MsgBox("Plus d'une intersection du type FacedeSection....")
113 CoupeFaceDeSection(lst_InterPoutre(1))
114 End If
115
116 End Sub
117
118 ''' <summary>
119 ''' sub qui CRÉÉ une instance de la classe InterPoutreVolume si et seulement si il n'en existe pas avant. S'il en existe alors on update la classe déjà existante.
120 ''' </summary>
121 ''' <param name="sPoutre">La SlyPoutre</param>
122 ''' <param name="xyz1">Laposition du pount d'intersection</param>
123 ''' <param name="tipe">=1 si on découpe en X, 2 si coupe Long, 3 si à l'extérieur, 5 si la section est partiellement découpée, 6 si face de section, mais pas sur cette face</param>
124 ''' <returns>La classe d'intersection</returns>
125 ''' <remarks>dans tous les cas on retourne la classe (pour pouvoir l'ajouter à la poutre...)</remarks>
126 Public Function AjouterInterPoutre(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterPoutreVolume
127
128 Dim int As InterPoutreVolume
129
130 For Each int In lst_InterPoutre
131 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
132 ' on a un point déjà existant,
133 int.lst_sPoutre.Add(sPoutre)
134 int.lst_type.Add(tipe)
135 Return int
136 End If
137 Next
138
139 ' si on est ici c'est que l'on doit créer l'intersection
140 int = New InterPoutreVolume
141
142 int.x = xyz1(0)
143 int.y = xyz1(1)
144 int.z = xyz1(2)
145
146 int.lst_sPoutre.Add(sPoutre)
147 int.lst_type.Add(tipe)
148 int.sFaceVolume = Me
149 lst_InterPoutre.Add(int)
150
151 If Commun.OptionMettreNoteIntersection = True Then
152 Dim texte As String = "Intersection # " & int.Numero & vbCr & "Poutre Volume FaceSection"
153 Commun.CreerAnnotation(xyz1(0), xyz1(1), xyz1(2), texte)
154 End If
155 Return int
156
157 End Function
158
159
160
161 ' sub qui update les pointeurs après un split de la face.
162 Protected Function UpdateApresSplit(ByRef inter As InterPoutreVolume, 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
163 ' le pointeur Me.swFace pointe soit sur une face, soit sur la face originale soit la face découpée
164 ' cette procédure doit créer une nouvelle SlyFaceVOl
165 ' et tout ce que j'ai c'est un pointeur, et je sais même pas lequel.
166 ' la fonction ne créée pas de nouvelles slyEntités.
167 ' si le découpage donne 3 faces ou plus, elles sont placées dans lst_AutreFaces
168
169
170 ' 1 - on obtient les 2 nouvelles faces,
171 Dim vFace As Object
172 Dim Face As sldworks.Face2 = Nothing
173 Dim FaceInterne As sldworks.Face2
174 Dim swFeat As sldworks.Feature
175 Dim swent As sldworks.Entity = Nothing
176 Dim swFaultEnt As sldworks.FaultEntity
177
178 swFeat = swModel.FeatureByPositionReverse(0)
179 Try
180 vFace = swFeat.GetFaces
181 For Each Face In vFace
182 Me.lst_Faces.Add(Face)
183 Next Face
184 Catch
185 ' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
186 ' on doit donc le déterminer anyway
187 End Try
188
189
190
191 For Each Face In Me.lst_Faces ' à revoir
192 swFaultEnt = Face.Check
193 If Not IsNothing(swFaultEnt) Then
194 Me.lst_Faces.GetEnumerator()
195 End If
196 Next Face
197
198
199 ' on créé un point dans un sketch et on le place
200 ' This method projects the selected sketch items from the current sketch on a selected surface.
201 ' en fait ça projette juste une courbe...
202 ' et si ça retourne nul alors la projection a pas marchée.
203 Dim swSKSeg As sldworks.SketchSegment
204 swSKSeg = Commun.MettreUneLigne(Plan, x - 20 * Epsilon, y - 20 * Epsilon, z, x + 20 * Epsilon, y + 20 * Epsilon, z)
205
206 swFeat = Nothing
207 For Each Face In Me.lst_Faces
208 swSKSeg.Select4(False, Nothing)
209 swent = Face : swent.Select4(True, Nothing)
210 swFeat = swModel.InsertProjectedSketch2(0) ' 1 pour inverser la direction de la projection
211 If Not swFeat Is Nothing Then Exit For
212 swFeat = swModel.InsertProjectedSketch2(1) ' 1 pour inverser la direction de la projection
213 If Not swFeat Is Nothing Then Exit For
214 Next Face
215
216
217 If swFeat Is Nothing Then
218 ' on passe à un autre type d'essai...
219
220
221
222
223 MsgBox("N'a pas réussi à trouver la bonne face dans le UpdateAPrèsSplit")
224 Return Nothing
225 Else
226 FaceInterne = Face
227 ' effacer le feature...
228 End If
229
230
231 ' ************************************************
232 ' pour placer un attribut sur la face interne
233 Dim attr As sldworks.Attribute
234 Dim p2 As sldworks.Parameter
235 Dim no As Integer = 0
236
237 If FI Or Flag = 20 Then
238 no = Me.MettreAttributFaceInterne(FaceInterne, poutre.SuggereGrosseurMaille, True)
239 'Dim nom2 As String = "FaceInterne" & no
240 'swent = FaceInterne
241 'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
242 'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
243 'While attr Is Nothing
244 ' no += 1
245 ' nom2 = "FaceInterne" & CStr(no)
246 ' attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
247 'End While
248 'p2 = attr.GetParameter("FI")
249 'p2.SetDoubleValue(poutre.SuggereGrosseurMaille)
250 'GererDossiers("FaceInternes", nom2)
251 'no += 1
252 ElseIf Flag = 2 Then ' on a un channel, on fait les 2 options
253 'Dim nom2 As String = "FaceInterne" & no
254 'swent = FaceInterne
255 'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
256 'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
257 'While attr Is Nothing
258 ' no += 1
259 ' nom2 = "FaceInterne" & CStr(no)
260 ' attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
261 'End While
262 'p2 = attr.GetParameter("FI")
263 'p2.SetDoubleValue(poutre.SuggereGrosseurMaille)
264 'GererDossiers("FaceInternes", nom2)
265 'no += 1
266 no = Me.MettreAttributFaceInterne(FaceInterne, poutre.SuggereGrosseurMaille, True)
267 MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
268 Else
269 MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
270 End If
271
272 ' ************ l'attribut de la condition aux limites *******************
273 attr = Nothing
274 Dim nom3 As String = Nothing
275 Dim p As sldworks.Parameter
276 If Not Me.condition = "" Then
277 nom3 = "CLc_" & no & "_" & Me.nom & " " & Me.condition
278 attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
279
280 While attr Is Nothing
281 If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, FaceInterne, nom3, 0, 0)
282 If attr Is Nothing Then nom3 = nom3 & CStr(Timer)
283 End While
284
285 p = attr.GetParameter("CL")
286 p.SetStringValue(Me.condition)
287
288 End If
289 GererDossiers("Conditions Aux Limites", nom3)
290 ' *****************************************************
291 Return FaceInterne
292
293 End Function
294
295 Private Sub MAJ_CL(ByRef FaceInterne As sldworks.Face)
296 ' ************ update de 'attribut de la condition aux limites *******************
297 Dim attr As sldworks.Attribute
298 Static no As Integer = 0
299 Dim swEnt As sldworks.Entity
300
301 swEnt = FaceInterne
302 attr = Nothing
303 Dim nom3 As String = Nothing
304 Dim p As sldworks.Parameter
305 If Not Me.condition = "" Then
306 nom3 = "CLv_" & 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
321 End Sub
322
323 Protected Sub CoupeX(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre)
324 Dim swEnt As sldworks.Entity = Nothing
325 Dim Directionnel As Boolean, Flip As Boolean
326 Dim Faces(3) As sldworks.Face2
327 Dim r(2) As Double
328 Dim LaSurface As sldworks.Surface
329 Dim sens As Boolean
330 Dim p(2) As Double
331 Dim retour() As Double
332
333 'swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
334 'swModel.SetAddToDB(True)
335 'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
336
337
338 ' l'idée est de sélectionner le point et l'arète puis d'utiliser CreatePlanePerCurveAndPassPoint3
339 Dim planReference As sldworks.RefPlane
340 Dim swsketch As sldworks.Sketch
341 Dim swSommet As sldworks.Vertex, swSommet2 As sldworks.Vertex
342 Dim pointdeb(2) As Double, pointfin(2) As Double
343
344 'swModel.Extension.SelectByID2("", "POINTREF", inter.x, inter.y, inter.z, False, 0, Nothing, 0)
345 ' faut vraiment sélectionner le bon point...
346 swSommet = poutre.swArete.GetStartVertex()
347 swSommet2 = poutre.swArete.GetEndVertex()
348 If swSommet Is Nothing Then
349 MsgBox("On a un cercle ou courbe sans sommets, dans coupeX, pas encore traité. Ne peut pas mettre un plan si pas de sommet")
350 Else
351 If Distance(swSommet, inter.x, inter.y, inter.z) < Epsilon Then
352 swEnt = swSommet
353 ElseIf Distance(swSommet2, inter.x, inter.y, inter.z) < Epsilon Then
354 swEnt = swSommet2
355 Else
356 MsgBox("Dans coupeX, l'intersection n'est pas sur un sommet. Pas encore traité. Nécessite de créer un point au coordonnées d'intersection")
357 End If
358 End If
359
360 swEnt.Select4(False, Nothing)
361 swEnt = poutre.swArete
362 swEnt.Select(True)
363
364 If Me.estPlan Or Me.estFauxPlan(inter.x, inter.y, inter.z) Then
365 ' si la coque est plane alors on projette le plan de référence des deux cotés, sinon on doit le décaler vers le bas
366 planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
367 Directionnel = False
368 Flip = False
369 ElseIf Me.estCylindre Then
370 ' on a un cylindre, on ne projette pas des 2 cotés. On créé un plan, puis un autre plus bas pour ensuite projeter d'un seul coté.
371 Dim PlanDessus As sldworks.RefPlane
372 Dim Rayon As Double, L As Double, B As Double, phi As Double, dist As Double, temp1 As Double, temp2 As Double
373 Dim u(2) As Double, v(2) As Double
374 PlanDessus = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
375 temp1 = poutre.GetD1
376 temp2 = poutre.GetD2
377 L = Math.Sqrt(temp1 * temp1 + temp2 * temp2)
378 Rayon = Me.GetRayonCylindre()
379 u = poutre.GetOrientation(inter.x, inter.y, inter.z)
380 v = Me.GetNormale(inter.x, inter.y, inter.z)
381 phi = -(Math.Acos(Outils_Math.cosdir(u, v)))
382 B = Math.Abs(L / 2 * Math.Sin(phi))
383 dist = Rayon - Math.Sqrt(Rayon * Rayon - ((L / 2) * (L / 2))) + B
384 If dist < 0 Then MsgBox("Gros problème pour couper le cylindre, la poutre est plus grosse!!!!!!", MsgBoxStyle.Critical) : Exit Sub
385
386 swEnt = PlanDessus
387 swEnt.Select(False)
388 Directionnel = True
389
390 Flip = Flipper(PlanDessus, inter)
391
392 planReference = swModel.CreatePlaneAtOffset3(dist * 2, Flip, True)
393 Else
394 MsgBox("La coque n'est ni un cylindre, ni un plan" & vbCr & "Le résultat n'est pas certain...", MsgBoxStyle.Information, "Avertissement")
395 planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
396 Directionnel = False
397 Flip = False
398 End If
399
400
401
402 LaSurface = Me.SwFace.GetSurface()
403 sens = Me.SwFace.FaceInSurfaceSense()
404
405 ' skx est la coordonnée du point de ref en coord de sketch, Rx est le point de référence dans le repère global.
406 Dim i As Integer, MettreFI As Boolean
407 Dim swFeat As sldworks.Feature
408
409 For i = 0 To 1
410
411 swEnt = planReference
412 swEnt.Select(False)
413 swModel.InsertSketch2(False)
414 swModel.ClearSelection2(True)
415 swFeat = swModel.FeatureByPositionReverse(0)
416 swModel.SelectByID(swFeat.Name, "SKETCH", 0, 0, 0)
417 swModel.EditSketch()
418 swsketch = swModel.GetActiveSketch2
419
420 p(0) = inter.x : p(1) = inter.y : p(2) = inter.z
421 retour = Commun.TransfertModelSketch(swsketch, p)
422
423
424 r = DessineSectionPoutre(poutre, retour(0), retour(1), i + 1, swsketch, inter, MettreFI)
425 swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
426 swModel.ClearSelection2(True)
427
428 Dim face As sldworks.Face2
429 For Each face In Me.lst_Faces
430 swModel.ClearSelection2(True)
431 swEnt = face : swEnt.Select2(False, 1)
432 swEnt = swsketch : swEnt.Select2(True, 4)
433 swModel.InsertSplitLineProject(Directionnel, Flip)
434 Next
435
436
437 Me.SwFace.DetachSurface()
438 Me.SwFace.AttachSurface(LaSurface, sens)
439
440 Faces(i) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, MettreFI)
441 Commun.MettreUnPoint(r(0), r(1), r(2))
442
443 If Faces(i) Is Nothing Then
444 swEnt.Select(False)
445 swModel.EditDelete()
446 End If
447 If Flag = 2 Then Flag = 0 : Exit For
448
449 Next i
450 End Sub
451
452
453
454
455 End Class