ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SlyFaceVolume.vb
Revision: 205
Committed: Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size: 19275 byte(s)
Log Message:
Commit de MAGiC_SLD pendant que j'y pense.  Les modifications ne devraient pas concerner personne d'autre que moi.   -- Sylvain

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 ' si on a un volme on ne vient plus ici
82 lst_coupeCinter.Add(inter)
83 lst_coupeCPoutre.Add(poutre3)
84 End If
85
86 If nb5 = 1 And (nb1 > 0 Or nb2 > 0 Or nb3 > 0) Then
87 MsgBox("Problème, on a un type d'intersection impossible dans la vraie vie!", MsgBoxStyle.Exclamation, "Design impossible à obtenir en réalité...")
88 End If
89
90
91 lst_poutre2.Clear()
92 nb1 = 0 : nb2 = 0 : nb3 = 0
93
94
95 Next inter
96
97
98 ' maintenant on a toutes les lists d'intersections. On les coupe.
99 For i = 1 To lst_coupeXinter.Count
100 CoupeX(lst_coupeXinter.Item(i), lst_coupeXPoutre.Item(i))
101 Next
102
103 For Each int As InterPoutreVolume In lst_coupeLinter ' i = 1 To lst_coupeLinter.Count
104 int.DecouperLong() 'CoupeLong(lst_coupeLinter.Item(i), lst_coupeLPoutre.Item(i))
105 Next
106
107 ' ne devrait pas avoir desoin de ça avec un volume
108 'For i = 1 To lst_coupeCinter.Count
109 ' CoupeCote(lst_coupeCinter.Item(i), lst_coupeCPoutre.Item(i))
110 'Next
111
112 If nb5 = 1 Then
113 If lst_InterPoutre.Count <> 1 Then MsgBox("Plus d'une intersection du type FacedeSection....")
114 CoupeFaceDeSection(lst_InterPoutre(1))
115 End If
116
117 End Sub
118
119 ''' <summary>
120 ''' 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.
121 ''' </summary>
122 ''' <param name="sPoutre">La SlyPoutre</param>
123 ''' <param name="xyz1">Laposition du pount d'intersection</param>
124 ''' <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>
125 ''' <returns>La classe d'intersection</returns>
126 ''' <remarks>dans tous les cas on retourne la classe (pour pouvoir l'ajouter à la poutre...)</remarks>
127 Public Function AjouterInterPoutre(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterPoutreVolume
128
129 Dim int As InterPoutreVolume
130
131 For Each int In lst_InterPoutre
132 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
133 ' on a un point déjà existant,
134 int.lst_sPoutre.Add(sPoutre)
135 int.lst_type.Add(tipe)
136 Return int
137 End If
138 Next
139
140 ' si on est ici c'est que l'on doit créer l'intersection
141 int = New InterPoutreVolume
142
143 int.x = xyz1(0)
144 int.y = xyz1(1)
145 int.z = xyz1(2)
146
147 int.lst_sPoutre.Add(sPoutre)
148 int.lst_type.Add(tipe)
149 int.sFaceVolume = Me
150 lst_InterPoutre.Add(int)
151
152 If Commun.OptionMettreNoteIntersection = True Then
153 Dim texte As String = "Intersection # " & int.Numero & vbCr & "Poutre Volume FaceSection"
154 Commun.CreerAnnotation(xyz1(0), xyz1(1), xyz1(2), texte)
155 End If
156 Return int
157
158 End Function
159
160
161
162
163 ''' <summary>
164 ''' Sub qui update les pointeurs après un split de la face.
165 ''' </summary>
166 ''' <param name="inter">La classe d'intersection</param>
167 ''' <param name="poutre">La poutre</param>
168 ''' <param name="x">Les coordonnées d'un point appartenant à la face Interne</param>
169 ''' <param name="y"></param>
170 ''' <param name="z"></param>
171 ''' <param name="Plan"></param>
172 ''' <param name="FI">Si vrai, on doit mettre un attribut de face iterne</param>
173 ''' <returns>La face de plus</returns>
174 ''' <remarks></remarks>
175 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, Optional ByRef AjouterMini As Boolean = False) As sldworks.Face2
176 ' le pointeur Me.swFace pointe soit sur une face, soit sur la face originale soit la face découpée
177 ' et tout ce que j'ai c'est un pointeur, et je sais même pas lequel.
178 ' la fonction ne créée pas de nouvelles slyEntités.
179 ' si le découpage donne 3 faces ou plus, elles sont placées dans lst_AutreFaces
180
181
182 ' 1 - on obtient les 2 nouvelles faces,
183 Dim vFace As Object
184 Dim Face As sldworks.Face2 = Nothing
185 Dim FaceInterne As sldworks.Face2
186 Dim swFeat As sldworks.Feature
187 Dim swent As sldworks.Entity = Nothing
188 Dim swFaultEnt As sldworks.FaultEntity
189
190 swFeat = swModel.FeatureByPositionReverse(0)
191 Try
192 vFace = swFeat.GetFaces
193 For Each Face In vFace
194 Me.lst_Faces.Add(Face)
195 Next Face
196 Catch
197 ' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
198 ' on doit donc le déterminer anyway
199 End Try
200
201
202
203 For Each Face In Me.lst_Faces ' à revoir
204 swFaultEnt = Face.Check
205 If Not IsNothing(swFaultEnt) Then
206 Me.lst_Faces.GetEnumerator()
207 End If
208 Next Face
209
210
211 ' on créé un point dans un sketch et on le place
212 ' This method projects the selected sketch items from the current sketch on a selected surface.
213 ' en fait ça projette juste une courbe...
214 ' et si ça retourne nul alors la projection a pas marchée.
215 Dim swSKSeg As sldworks.SketchSegment
216 swSKSeg = Commun.MettreUneLigne(Plan, x - 20 * Epsilon, y - 20 * Epsilon, z, x + 20 * Epsilon, y + 20 * Epsilon, z)
217
218 swFeat = Nothing
219 For Each Face In Me.lst_Faces
220 swSKSeg.Select4(False, Nothing)
221 swent = Face : swent.Select4(True, Nothing)
222 swFeat = swModel.InsertProjectedSketch2(0) ' 1 pour inverser la direction de la projection
223 If swFeat IsNot Nothing Then Exit For
224 swFeat = swModel.InsertProjectedSketch2(1) ' 1 pour inverser la direction de la projection
225 If swFeat IsNot Nothing Then Exit For
226 Next Face
227
228
229 If swFeat Is Nothing Then
230 ' on passe à un autre type d'essai...
231 Dim dist As Double
232 For Each Face In Me.lst_Faces
233 dist = swModel.ClosestDistance(Face, swSKSeg, Nothing, Nothing)
234 If Math.Abs(dist) < Epsilon Then FaceInterne = Face : Exit For
235 Next Face
236
237
238 If FaceInterne Is Nothing Then MsgBox("N'a pas réussi à trouver la bonne face dans le UpdateAPrèsSplit")
239 Return Nothing
240
241
242 Else
243 FaceInterne = Face
244 ' effacer le feature...
245 End If
246
247
248 ' ************************************************
249 ' pour placer un attribut sur la face interne
250 Dim attr As sldworks.Attribute
251 Dim no As Integer = 0
252
253 If Flag = 20 Then MsgBox("Le flag = 20, voir ici...")
254
255 If FI Then no = Me.MettreAttributFaceInterne(FaceInterne, poutre.SuggereGrosseurMaille, True)
256 If AjouterMini Then MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
257
258
259 'If Flag = 2 Then ' on a un channel, on fait les 2 options
260 ' no = Me.MettreAttributFaceInterne(FaceInterne, poutre.SuggereGrosseurMaille, True)
261 ' MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
262 'ElseIf FI Or Flag = 20 Then
263 ' no = Me.MettreAttributFaceInterne(FaceInterne, poutre.SuggereGrosseurMaille, True)
264 'Else
265 ' MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
266 'End If
267
268 ' ************ l'attribut de la condition aux limites *******************
269 attr = Nothing
270 Dim nom3 As String = Nothing
271 Dim p As sldworks.Parameter
272 If Not Me.condition = "" Then
273 nom3 = "CLc_" & no & "_" & Me.nom & " " & Me.condition
274 attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
275
276 While attr Is Nothing
277 If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, FaceInterne, nom3, 0, 0)
278 If attr Is Nothing Then nom3 = nom3 & CStr(Timer)
279 End While
280
281 p = attr.GetParameter("CL")
282 p.SetStringValue(Me.condition)
283
284 End If
285 GererDossiers("Conditions Aux Limites", nom3)
286 ' *****************************************************
287 Return FaceInterne
288
289 End Function
290
291 Private Sub MAJ_CL(ByRef FaceInterne As sldworks.Face)
292 ' ************ update de 'attribut de la condition aux limites *******************
293 Dim attr As sldworks.Attribute
294 Static no As Integer = 0
295 Dim swEnt As sldworks.Entity
296
297 swEnt = FaceInterne
298 attr = Nothing
299 Dim nom3 As String = Nothing
300 Dim p As sldworks.Parameter
301 If Not Me.condition = "" Then
302 nom3 = "CLv_" & no & "_" & Me.nom & " " & Me.condition
303 attr = swEnt.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
304
305 While attr Is Nothing
306 If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, FaceInterne, nom3, 0, 0)
307 If attr Is Nothing Then nom3 = nom3 & CStr(Timer)
308 End While
309
310 p = attr.GetParameter("CL")
311 p.SetStringValue(Me.condition)
312
313 End If
314 GererDossiers("Conditions Aux Limites", nom3)
315 ' *****************************************************
316
317 End Sub
318
319 Protected Sub CoupeX(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre)
320 Dim swEnt As sldworks.Entity = Nothing
321 Dim Directionnel As Boolean, Flip As Boolean
322 Dim Faces(3) As sldworks.Face2
323 Dim r(2) As Double
324 Dim LaSurface As sldworks.Surface
325 Dim sens As Boolean
326 Dim p(2) As Double
327 Dim retour() As Double
328
329
330 ' l'idée est de sélectionner le point et l'arète puis d'utiliser CreatePlanePerCurveAndPassPoint3
331 Dim planReference As sldworks.RefPlane
332 Dim swsketch As sldworks.Sketch
333 Dim swSommet As sldworks.Vertex, swSommet2 As sldworks.Vertex
334 Dim pointdeb(2) As Double, pointfin(2) As Double
335
336 'swModel.Extension.SelectByID2("", "POINTREF", inter.x, inter.y, inter.z, False, 0, Nothing, 0)
337 ' faut vraiment sélectionner le bon point...
338 swSommet = poutre.swArete.GetStartVertex()
339 swSommet2 = poutre.swArete.GetEndVertex()
340 If swSommet Is Nothing Then
341 MsgBox("On a un cercle ou courbe sans sommets, dans coupeX, pas encore traité. Ne peut pas mettre un plan si pas de sommet")
342 Else
343 If Distance(swSommet, inter.x, inter.y, inter.z) < Epsilon Then
344 swEnt = swSommet
345 ElseIf Distance(swSommet2, inter.x, inter.y, inter.z) < Epsilon Then
346 swEnt = swSommet2
347 Else
348 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")
349 End If
350 End If
351
352 swEnt.Select4(False, Nothing)
353 swEnt = poutre.swArete
354 swEnt.Select(True)
355
356 If Me.estPlan Or Me.estFauxPlan(inter.x, inter.y, inter.z) Then
357 ' 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
358 planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
359 Directionnel = False
360 Flip = False
361 ElseIf Me.estCylindre Then
362 ' 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é.
363 Dim PlanDessus As sldworks.RefPlane
364 Dim Rayon As Double, L As Double, B As Double, phi As Double, dist As Double, temp1 As Double, temp2 As Double
365 Dim u(2) As Double, v(2) As Double
366 PlanDessus = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
367 temp1 = poutre.GetD1
368 temp2 = poutre.GetD2
369 L = Math.Sqrt(temp1 * temp1 + temp2 * temp2)
370 Rayon = Me.GetRayonCylindre()
371 u = poutre.GetOrientation(inter.x, inter.y, inter.z)
372 v = Me.GetNormale(inter.x, inter.y, inter.z)
373 phi = -(Math.Acos(Outils_Math.cosdir(u, v)))
374 B = Math.Abs(L / 2 * Math.Sin(phi))
375 dist = Rayon - Math.Sqrt(Rayon * Rayon - ((L / 2) * (L / 2))) + B
376 If dist < 0 Then MsgBox("Gros problème pour couper le cylindre, la poutre est plus grosse!!!!!!", MsgBoxStyle.Critical) : Exit Sub
377
378 swEnt = PlanDessus
379 swEnt.Select(False)
380 Directionnel = True
381
382 Flip = Flipper(PlanDessus, inter)
383
384 planReference = swModel.CreatePlaneAtOffset3(dist * 2, Flip, True)
385 Else
386 MsgBox("La coque n'est ni un cylindre, ni un plan" & vbCr & "Le résultat n'est pas certain...", MsgBoxStyle.Information, "Avertissement")
387 planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
388 Directionnel = False
389 Flip = False
390 End If
391
392
393
394 LaSurface = Me.SwFace.GetSurface()
395 sens = Me.SwFace.FaceInSurfaceSense()
396
397 ' 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.
398
399 Dim MettreFI As Boolean ' si vrai, on met un attribut de face interne
400 Dim swFeat As sldworks.Feature
401 Dim AutreSection As Boolean = True ' si vrai, on doit découper une autre face.
402 Dim i As Integer = 0
403 Dim AjouterMiniPoutre As Boolean = False
404
405 Do While AutreSection
406 i += 1
407 swEnt = planReference
408 swEnt.Select(False)
409 swModel.InsertSketch2(False)
410 swModel.ClearSelection2(True)
411 swFeat = swModel.FeatureByPositionReverse(0)
412 swModel.SelectByID(swFeat.Name, "SKETCH", 0, 0, 0)
413 swModel.EditSketch()
414 swsketch = swModel.GetActiveSketch2
415
416 p(0) = inter.x : p(1) = inter.y : p(2) = inter.z
417 retour = Commun.TransfertModelSketch(swsketch, p)
418
419 If SectionSimpleSurPoutre = True Then
420 r = DessineSectionPoutreSimple(poutre, retour(0), retour(1), i, swsketch, CType(inter, InterAreteFace), MettreFI, AutreSection, AjouterMiniPoutre)
421 Else
422 r = DessineSectionPoutre(poutre, retour(0), retour(1), i, swsketch, CType(inter, InterAreteFace), MettreFI, AutreSection, AjouterMiniPoutre)
423 End If
424
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, AjouterMiniPoutre)
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
448 Loop
449
450
451
452 End Sub
453
454
455
456
457 End Class