ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SlyFaceVolume.vb
Revision: 48
Committed: Wed Aug 22 21:18:12 2007 UTC (17 years, 8 months ago) by bournival
File size: 8649 byte(s)
Log Message:
On passe aux nouveaux .dll

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