ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SlyFaceCoque.vb
Revision: 40
Committed: Mon Aug 20 21:30:28 2007 UTC (17 years, 9 months ago) by bournival
File size: 13320 byte(s)
Log Message:
Projet de these de Sylvain Bournival. Attention projet VB.

File Contents

# User Rev Content
1 bournival 40 Public Class SlyFaceCoque
2     Inherits SuperFace
3    
4    
5     Public 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    
84     Public Function GetEpaisseur() As Double
85     If Not Me.epaisseur = 0 Then Return Me.epaisseur : Exit Function ' pour optimiser
86    
87    
88     Dim p As SldWorks.Parameter
89    
90     Try
91     p = swAttribute.GetParameter("Ep")
92     Catch ex As Exception
93     MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'épaisseur, la coque n'a peut-être pas d'attributs...")
94     Return 0
95     End Try
96    
97     Me.epaisseur = p.GetDoubleValue
98     Return p.GetDoubleValue
99     End Function
100    
101     Public Function GetMateriau() As String
102     If Not Me.materiau Then Return Me.materiau : Exit Function ' pour optimiser
103    
104    
105     Dim p As SldWorks.Parameter = Nothing
106    
107     Try
108     p = swAttribute.GetParameter("M")
109     Catch ex As Exception
110     MsgBox("N'arrive pas à se lier à l'attribut pour obtenir le matériau, la coque n'a peut-être pas d'attributs...")
111     End Try
112     Me.materiau = p.GetStringValue
113     Return p.GetStringValue
114     End Function
115    
116     Public Function GetAttribute() As SldWorks.Attribute
117     Dim ent As SldWorks.Entity
118     Dim attr As SldWorks.Attribute = Nothing
119    
120     Try
121     ent = lst_Faces.Item(1)
122     attr = ent.FindAttribute(Intersections.DefAttrRCCoque, 0)
123     Me.swAttribute = attr
124     Catch ex As Exception
125     MsgBox("ERREUR! Une coque sans attributs !", MsgBoxStyle.Critical)
126     End Try
127     If IsNothing(attr) Then ' on a trouvé un attribut de coque
128     MsgBox("Une coque sans attributs !")
129     End If
130     Return attr
131     End Function
132    
133     Private Function PointInterne(ByRef P1() As Double, ByRef P2() As Double, ByRef centreX As Double, ByRef centreY As Double) As Double()
134     Dim b(1) As Double
135     Dim c(1) As Double
136     Dim d(1) As Double
137     b(0) = P1(0) - centreX
138     b(1) = P1(1) - centreY
139     c(0) = P1(0) - centreX
140     c(1) = P1(1) - centreY
141    
142     b = Outils_Math.unitaire(b)
143     c = Outils_Math.unitaire(c)
144    
145     d(0) = ((b(0) + c(0)) / 2) * 50 * Epsilon
146     d(1) = ((b(0) + c(0)) / 2) * 50 * Epsilon
147    
148     Return d
149    
150     End Function
151    
152     ' cette sub ajoute LES constantes de la coque aux nom de l'entité.
153     Public Sub AddConstantes()
154     ' cette sub ajoute LES constantes de la coque aux nom de l'entité.
155     ' on suppose qu'il n'y en a pas déjà
156     ' tout ce que j'ai à faire c'est de modifier la propriété nom.
157    
158     'Format(valeur, "0.00000e+000")
159     Dim epaisseur As Double
160    
161    
162     epaisseur = Me.GetEpaisseur()
163     If epaisseur <= 0 Then
164     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")
165     epaisseur = 1
166     Dim ent As SldWorks.Entity
167     ent = Me.swFace : ent.Select4(False, Nothing)
168     swModel.SelectedFaceProperties(1, 0, 0, 0, 0, 0, 0, False, "")
169     End If
170    
171    
172     nom = nom & "¢" & Format(epaisseur, "0.00000e+000") & "MA" & Format(materiau, "00")
173    
174     ' attention, s'il y a une intersection, je dois la noter et l'ajouter au nom....
175     Dim c As Integer
176     For c = 1 To Len(nom)
177     If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
178     Next c
179     End Sub
180    
181    
182    
183     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
184    
185     ' le pointeur Me.swFace pointe soit sur une face, soit sur la face originale soit la face découpée
186     ' cette procédure doit créer une nouvelle SlyFaceCoque
187     ' et tout ce que j'ai c'est un pointeur, et je sais même pas lequel.
188     ' la fonction ne créée pas de nouvelles slyEntités.
189     ' si le découpage donne 3 faces ou plus, elles sont placées dans lst_AutreFaces
190    
191    
192     ' 1 - on obtient les 2 nouvelles faces,
193     Dim vFace As Object
194     Dim Face1 As SldWorks.Face2
195     Dim Face2 As SldWorks.Face2
196     Dim FaceInterne As SldWorks.Face2
197     Dim FaceExterne As SldWorks.Face2
198     Dim swFeat As SldWorks.Feature
199    
200     swFeat = swModel.FeatureByPositionReverse(0)
201     vFace = swFeat.GetFaces
202    
203     If vFace Is Nothing Then Return Nothing ' le code nothing veut dire que la face n'a pas été coupée.
204    
205     Face1 = vFace(0)
206     Face2 = vFace(1)
207    
208     Try ' vérification
209     Dim face3 As SldWorks.Face2
210     Dim i As Integer
211     'Dim slyFaceSupplémentaire As SlyFaceCoque ' la raison du pourquoi on doit avoir 2 sous-routines
212    
213     For i = 2 To 1000
214     face3 = vFace(i)
215     Me.lst_Faces.Add(face3)
216     Next i
217    
218     'MsgBox("Problème, on a au moins 3 face dans le update après le découpage", MsgBoxStyle.Critical)
219     Catch ex As Exception
220     ' tout est normal...
221     End Try
222    
223     ' SECRET 1.999 ' c'est pas scientifique mais ça peut marcher
224     If Math.Abs(Face1.GetArea) > Math.Abs(10 * Face2.GetArea) Then
225     FaceInterne = Face2
226     FaceExterne = Face1
227     ElseIf Math.Abs(Face1.GetArea) < Math.Abs(10 * Face2.GetArea) Then
228     FaceInterne = Face1
229     FaceExterne = Face2
230     Else
231    
232    
233     '' 2 - on a un point, on trouve quelle face est la plus proche.
234     If Commun.Distance(Face1, x, y, z) < Commun.Distance(Face2, x, y, z) Then
235     FaceInterne = Face1
236     FaceExterne = Face2
237     Else
238     FaceInterne = Face2
239     FaceExterne = Face1
240     End If
241     End If
242    
243     Me.lst_Faces.Add(FaceInterne)
244     Me.lst_Faces.Add(FaceExterne)
245    
246     '' 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
247     'Me.swFace = FaceExterne
248     Dim aire As Double
249     aire = FaceExterne.GetArea
250    
251     ' ************************************************
252     ' pour placer un attribut sur la face interne
253     Dim attr As SldWorks.Attribute
254     Dim swent As SldWorks.Entity
255     Static no As Integer
256    
257     If FI Then
258     Dim nom2 As String = "FaceInterne" & no
259    
260     swent = FaceInterne
261     attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
262    
263     If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
264    
265     While attr Is Nothing
266     no += 1
267     nom2 = "FaceInterne" & CStr(no)
268     attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
269     End While
270     GererDossiers("FaceInternes", nom2)
271     no += 1
272     ElseIf Flag = 2 Then ' on a un channel, on fait les 2 options
273     Dim nom2 As String = "FaceInterne" & no
274    
275     swent = FaceInterne
276     attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
277    
278     If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
279    
280     While attr Is Nothing
281     no += 1
282     nom2 = "FaceInterne" & CStr(no)
283     attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
284     End While
285     GererDossiers("FaceInternes", nom2)
286     no += 1
287     MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
288     Else
289     MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
290     End If
291    
292     ' ************ l'attribut de la condition aux limites *******************
293     'attr = Nothing
294     'Dim nom3 As String
295     'Dim p As SldWorks.Parameter
296     'If Not Me.condition = "" Then
297     ' nom3 = "CLc_" & no & "_" & Me.nom & " " & Me.condition
298     ' attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
299    
300     ' While attr Is Nothing
301     ' If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, FaceInterne, nom3, 0, 0)
302     ' If attr Is Nothing Then nom3 = nom3 & CStr(Timer)
303     ' End While
304    
305     ' p = attr.GetParameter("CL")
306     ' p.SetStringValue(Me.condition)
307    
308     'End If
309     ' GererDossiers("Conditions Aux Limites", nom3)
310     ' *****************************************************
311     Return FaceInterne
312    
313    
314     End Function
315    
316     Public Sub SetAttributDeCoque(ByRef epaisseur As Double, Optional ByRef materiau As String = Nothing)
317     Dim nom As String
318     Dim swFace As SldWorks.Face2
319     Dim swent As SldWorks.Entity
320     Dim no As Long
321     Dim Attr As SldWorks.Attribute
322    
323     swFace = Me.SwFace
324     swent = swFace
325    
326    
327     Try
328     Attr = swent.FindAttribute(Intersections.DefAttrRCCoque, 0) ' si l'attribut existe déjà on pointe dessus.
329     Catch ex As Exception
330     'MsgBox("N'arrive pas à se lier à l'attribut!", MsgBoxStyle.Information, "SetAttributsDePoutre")
331     Exit Sub
332     End Try
333    
334     If Attr Is Nothing Then Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 2) ' 0 = swThisconfig
335    
336     While Attr Is Nothing
337     no += 1
338     nom = "RCCoque" & CStr(no)
339     Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 0)
340     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")
341    
342     End While
343    
344    
345     Dim ParamM As SldWorks.Parameter
346     Dim ParamEp As SldWorks.Parameter
347    
348     ParamM = Attr.GetParameter("M")
349     ParamEp = Attr.GetParameter("Ep")
350    
351     If materiau IsNot Nothing Then ParamM.SetStringValue2(materiau, 2, "") ' swAllConfiguration = 2
352     ParamEp.SetStringValue2(epaisseur, 2, "")
353    
354     End Sub
355    
356    
357     End Class
358