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

# User Rev Content
1 bournival 48 Imports SolidWorks.Interop
2     Imports SolidWorks.Interop.swconst
3     Imports SolidWorks.Interop.swpublished
4    
5 bournival 40 Public Class SlyFaceVolume
6     Inherits SuperFace
7    
8    
9 bournival 130 Sub New(ByVal swface As sldworks.Face2)
10 bournival 48 MyBase.New(swface)
11 bournival 40 End Sub
12    
13    
14    
15 bournival 130 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 bournival 205 ' si on a un volme on ne vient plus ici
82 bournival 130 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 bournival 40 ''' <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 bournival 130 ''' <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 bournival 40 ''' <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 bournival 130
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 bournival 40 Return int
157    
158     End Function
159    
160    
161    
162 bournival 205
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 bournival 40 ' 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 bournival 130 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 bournival 40
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 bournival 130 ' on doit donc le déterminer anyway
199 bournival 40 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 bournival 130 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 bournival 40
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 bournival 205 If swFeat IsNot Nothing Then Exit For
224 bournival 40 swFeat = swModel.InsertProjectedSketch2(1) ' 1 pour inverser la direction de la projection
225 bournival 205 If swFeat IsNot Nothing Then Exit For
226 bournival 40 Next Face
227    
228    
229     If swFeat Is Nothing Then
230     ' on passe à un autre type d'essai...
231 bournival 205 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 bournival 40
237 bournival 130
238 bournival 205 If FaceInterne Is Nothing Then MsgBox("N'a pas réussi à trouver la bonne face dans le UpdateAPrèsSplit")
239     Return Nothing
240 bournival 130
241    
242 bournival 40 Else
243     FaceInterne = Face
244     ' effacer le feature...
245     End If
246    
247    
248     ' ************************************************
249     ' pour placer un attribut sur la face interne
250 bournival 130 Dim attr As sldworks.Attribute
251     Dim no As Integer = 0
252 bournival 40
253 bournival 205 If Flag = 20 Then MsgBox("Le flag = 20, voir ici...")
254 bournival 40
255 bournival 205 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 bournival 40 ' ************ l'attribut de la condition aux limites *******************
269     attr = Nothing
270     Dim nom3 As String = Nothing
271 bournival 130 Dim p As sldworks.Parameter
272 bournival 40 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 bournival 130 Private Sub MAJ_CL(ByRef FaceInterne As sldworks.Face)
292 bournival 40 ' ************ update de 'attribut de la condition aux limites *******************
293 bournival 130 Dim attr As sldworks.Attribute
294 bournival 40 Static no As Integer = 0
295 bournival 130 Dim swEnt As sldworks.Entity
296 bournival 40
297     swEnt = FaceInterne
298     attr = Nothing
299     Dim nom3 As String = Nothing
300 bournival 130 Dim p As sldworks.Parameter
301 bournival 40 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 bournival 130 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 bournival 40
329    
330 bournival 130 ' 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 bournival 205
399     Dim MettreFI As Boolean ' si vrai, on met un attribut de face interne
400 bournival 130 Dim swFeat As sldworks.Feature
401 bournival 205 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 bournival 130
405 bournival 205 Do While AutreSection
406     i += 1
407 bournival 130 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 bournival 205 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 bournival 130
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 bournival 205 Faces(i) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, MettreFI, AjouterMiniPoutre)
441     'Commun.MettreUnPoint(r(0), r(1), r(2))
442 bournival 130
443     If Faces(i) Is Nothing Then
444     swEnt.Select(False)
445     swModel.EditDelete()
446     End If
447    
448 bournival 205 Loop
449    
450    
451    
452 bournival 130 End Sub
453    
454    
455    
456    
457 bournival 40 End Class