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

File Contents

# Content
1 Public Class SlyFaceVolume
2 Inherits SuperFace
3
4
5 Sub New(ByVal swface As SldWorks.Face2)
6 MyBase.New(swFace)
7 End Sub
8
9
10
11 ''' <summary>
12 ''' 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.
13 ''' </summary>
14 ''' <param name="sPoutre">La SlyPoutre</param>
15 ''' <param name="xyz1">Laposition du pount d'intersection</param>
16 ''' <param name="tipe">=1 si on découpe en X, 2 si à l'intérieur, 3 si à l'extérieur</param>
17 ''' <returns>La classe d'intersection</returns>
18 ''' <remarks>dans tous les cas on retourne la classe (pour pouvoir l'ajouter à la poutre...)</remarks>
19 Public Function AjouterInterPoutre(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterPoutreVolume
20
21 Dim int As InterPoutreVolume
22
23 For Each int In lst_InterPoutre
24 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
25 ' on a un point déjà existant,
26 int.lst_sPoutre.Add(sPoutre)
27 int.lst_type.Add(tipe)
28 Return int
29 End If
30 Next
31
32
33 ' si on est ici c'est que l'on doit créer l'intersection
34 int = New InterPoutreVolume
35
36 int.x = xyz1(0)
37 int.y = xyz1(1)
38 int.z = xyz1(2)
39
40 int.lst_sPoutre.Add(sPoutre)
41 int.lst_type.Add(tipe)
42 int.sFaceVolume = Me
43 lst_InterPoutre.Add(int)
44 Return int
45
46 End Function
47
48
49
50 ' sub qui update les pointeurs après un split de la face.
51 Friend Overrides 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
52 ' le pointeur Me.swFace pointe soit sur une face, soit sur la face originale soit la face découpée
53 ' cette procédure doit créer une nouvelle SlyFaceVOl
54 ' et tout ce que j'ai c'est un pointeur, et je sais même pas lequel.
55 ' la fonction ne créée pas de nouvelles slyEntités.
56 ' si le découpage donne 3 faces ou plus, elles sont placées dans lst_AutreFaces
57
58
59 ' 1 - on obtient les 2 nouvelles faces,
60 Dim vFace As Object
61 Dim Face As SldWorks.Face2 = Nothing
62 Dim FaceInterne As SldWorks.Face2
63 Dim swFeat As SldWorks.Feature
64 Dim swent As SldWorks.Entity = Nothing
65 Dim swFaultEnt As SldWorks.FaultEntity
66
67 swFeat = swModel.FeatureByPositionReverse(0)
68 Try
69 vFace = swFeat.GetFaces
70 For Each Face In vFace
71 Me.lst_Faces.Add(Face)
72 Next Face
73 Catch
74 ' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
75 ' on doit donc l'e déterminer anyway
76 End Try
77
78
79
80 For Each Face In Me.lst_Faces ' à revoir
81 swFaultEnt = Face.Check
82 If Not IsNothing(swFaultEnt) Then
83 Me.lst_Faces.GetEnumerator()
84 End If
85 Next Face
86
87
88 ' on créé un point dans un sketch et on le place
89 ' This method projects the selected sketch items from the current sketch on a selected surface.
90 ' en fait ça projette juste une courbe...
91 ' et si ça retourne nul alors la projection a pas marchée.
92 Dim swSKSeg As SldWorks.SketchSegment
93 swSKSeg = Commun.MettreUneLigne(Plan, x - 50 * Epsilon, y, z, x + 100 * Epsilon, y + 100 * Epsilon, z + 100 * Epsilon)
94
95 swFeat = Nothing
96 For Each Face In Me.lst_Faces
97 swSKSeg.Select4(False, Nothing)
98 swent = Face : swent.Select4(True, Nothing)
99 swFeat = swModel.InsertProjectedSketch2(0) ' 1 pour inverser la direction de la projection
100 If Not swFeat Is Nothing Then Exit For
101 swFeat = swModel.InsertProjectedSketch2(1) ' 1 pour inverser la direction de la projection
102 If Not swFeat Is Nothing Then Exit For
103 Next Face
104
105
106 If swFeat Is Nothing Then
107 ' on passe à un autre type d'essai...
108
109 MsgBox("N'a pas réussi à trouver la bonne face dans le UpdateAPrèsSplit")
110 Return Nothing
111 Else
112 FaceInterne = Face
113 ' effacer le feature...
114 End If
115
116
117 ' ************************************************
118 ' pour placer un attribut sur la face interne
119 Dim attr As SldWorks.Attribute
120
121 Static no As Integer
122
123 If FI Or Flag = 20 Then
124 Dim nom2 As String = "FaceInterne" & no
125 swent = FaceInterne
126 attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
127 If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
128 While attr Is Nothing
129 no += 1
130 nom2 = "FaceInterne" & CStr(no)
131 attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
132 End While
133 GererDossiers("FaceInternes", nom2)
134 no += 1
135 ElseIf Flag = 2 Then ' on a un channel, on fait les 2 options
136 Dim nom2 As String = "FaceInterne" & no
137
138 swent = FaceInterne
139 attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
140
141 If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
142
143 While attr Is Nothing
144 no += 1
145 nom2 = "FaceInterne" & CStr(no)
146 attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
147 End While
148 GererDossiers("FaceInternes", nom2)
149 no += 1
150 MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
151 Else
152 MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
153 End If
154
155 ' ************ l'attribut de la condition aux limites *******************
156 attr = Nothing
157 Dim nom3 As String = Nothing
158 Dim p As SldWorks.Parameter
159 If Not Me.condition = "" Then
160 nom3 = "CLc_" & no & "_" & Me.nom & " " & Me.condition
161 attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
162
163 While attr Is Nothing
164 If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, FaceInterne, nom3, 0, 0)
165 If attr Is Nothing Then nom3 = nom3 & CStr(Timer)
166 End While
167
168 p = attr.GetParameter("CL")
169 p.SetStringValue(Me.condition)
170
171 End If
172 GererDossiers("Conditions Aux Limites", nom3)
173 ' *****************************************************
174 Return FaceInterne
175
176 End Function
177
178 Private Sub MAJ_CL(ByRef FaceInterne As SldWorks.Face)
179 ' ************ update de 'attribut de la condition aux limites *******************
180 Dim attr As SldWorks.Attribute
181 Static no As Integer = 0
182 Dim swEnt As SldWorks.Entity
183
184 swEnt = FaceInterne
185 attr = Nothing
186 Dim nom3 As String = Nothing
187 Dim p As SldWorks.Parameter
188 If Not Me.condition = "" Then
189 nom3 = "CLv_" & no & "_" & Me.nom & " " & Me.condition
190 attr = swEnt.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
191
192 While attr Is Nothing
193 If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, FaceInterne, nom3, 0, 0)
194 If attr Is Nothing Then nom3 = nom3 & CStr(Timer)
195 End While
196
197 p = attr.GetParameter("CL")
198 p.SetStringValue(Me.condition)
199
200 End If
201 GererDossiers("Conditions Aux Limites", nom3)
202 ' *****************************************************
203
204 End Sub
205
206
207
208
209 End Class