ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/EnregistrementCode.vb
Revision: 130
Committed: Wed Jul 30 21:26:03 2008 UTC (16 years, 9 months ago) by bournival
File size: 16527 byte(s)
Log Message:
Une mise à jour, car on aura peut-être besoin de mon code.

File Contents

# Content
1 Imports SolidWorks.Interop
2 Imports SolidWorks.Interop.swconst
3 Imports SolidWorks.Interop.swpublished
4
5 Namespace Enregistrement
6 Module EnregistrementCode
7
8
9 Public Groupe2 As SldWorks.PropertyManagerPageGroup ' pour la pré-optimisation de maillage
10 Public Groupe3 As SldWorks.PropertyManagerPageGroup ' pour le découpage de la géométrie (multidimensionnel)
11 Public Groupe4 As SldWorks.PropertyManagerPageGroup
12
13 Public checkboxOriginal As SldWorks.PropertyManagerPageCheckbox
14 Public checkboxModifie As SldWorks.PropertyManagerPageCheckbox
15
16 Public checkbox1 As SldWorks.PropertyManagerPageCheckbox
17 Public numberbox1 As SldWorks.PropertyManagerPageNumberbox
18 Public checkMultimodele As SldWorks.PropertyManagerPageCheckbox
19
20 Public checkArrondi As SldWorks.PropertyManagerPageCheckbox
21 Public checkRentrant As SldWorks.PropertyManagerPageCheckbox
22 Public checkMatiere As SldWorks.PropertyManagerPageCheckbox
23
24 Public NumberArrondi As SldWorks.PropertyManagerPageNumberbox
25 Public NumberRentrant As SldWorks.PropertyManagerPageNumberbox
26 Public NumberMatiere As SldWorks.PropertyManagerPageNumberbox
27
28 Public NumberENG As SldWorks.PropertyManagerPageNumberbox
29
30 Public checkEntites As SldWorks.PropertyManagerPageCheckbox
31 Public CheckEnt As SldWorks.PropertyManagerPageCheckbox
32
33 Public Numberentités As SldWorks.PropertyManagerPageNumberbox
34 Public selectionpog As SldWorks.PropertyManagerPageSelectionbox
35
36 Public Gilles1 As SldWorks.PropertyManagerPageCheckbox
37 Public Gilles2 As SldWorks.PropertyManagerPageCheckbox
38 Public bGilles1 As Boolean
39 Public bGilles2 As Boolean
40
41 Public curseur As sldworks.PropertyManagerPageSlider
42 Public limiteur As SldWorks.PropertyManagerPageNumberbox
43 Public labelRemi1 As sldworks.PropertyManagerPageLabel
44
45
46 Private vNumberENG As Double
47 Private vNumberbox1 As Double
48 Private vcheckArrondi As Boolean
49 Private vNumberArrondi As Double
50 Private vcheckRentrant As Boolean
51 Private vNumberRentrant As Double
52 Private vcheckMatiere As Boolean
53 Private vNumberMatiere As Double
54 Private vcheckEntites As Boolean
55 Private vNumberentités As Double
56 Private vCheckEnt As Boolean
57
58 Public ValeurSliderRemi As Double
59
60 Private vcheckboxOriginal As Boolean
61 Private vcheckboxModifie As Boolean
62
63 Public checkboxMiniSurCoque As sldworks.PropertyManagerPageCheckbox
64 Public checkboxMultidecoupage As sldworks.PropertyManagerPageCheckbox
65
66 Public decoupe As Boolean ' pas le choix, si je met la variable dans le page handler, il plante à la fermeture.
67 Public POGManuel As Boolean
68 Public PogAutomatique As Boolean
69
70
71
72
73 Public Lst_BodyCL As New Collection
74
75 Public sauvegarder As Boolean = False
76
77 Public Sub OK()
78 Dim errors As Long, warnings As Long ' on sauvegarde le fichier original
79 Dim nomFichier As String
80 Dim nomfichier2 As String
81 Dim NomFichierPog As String = Nothing
82 Dim temps As Integer = My.Computer.Clock.TickCount
83 Dim tempsTraitement As Integer
84 Dim tempsFusion As Integer
85 'Dim NomAppli As String
86
87 Commun.NomFichierPog = Nothing ' remettre la valeur à 0...
88 If Not sauvegarder Then Return
89 Commun.ÉcartNodal = vNumberENG
90 If POGManuel Then
91 Commun.NomFichierPog = PoGCode.DebutManuel(vNumberENG, Int(vNumberbox1), vcheckArrondi, vNumberArrondi, vcheckRentrant, vNumberRentrant, vcheckMatiere, vNumberMatiere, vcheckEntites, selectionpog, vNumberentités, vCheckEnt)
92 ElseIf PogAutomatique Then
93 Commun.NomFichierPog = PoGCode.DebutAutomatique(ValeurSliderRemi, limiteur.Value)
94 End If
95
96
97 swModel.Save3(SwConst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
98
99
100 ' on vient de cliquer sur le bouton ok pour enregistrer
101 nomFichier = swModel.GetPathName()
102 nomfichier2 = Left(nomFichier, Len(nomFichier) - 7)
103
104 ' première sauvegarde pour se débarasser du modèle original
105 nomfichier2 = nomfichier2 + "MAGiC" + ".Sldprt"
106 swModel.SaveAs4(nomfichier2, SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent + SwConst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
107 If errors = SwConst.swFileSaveError_e.swFileSaveAsDoNotOverwrite Then
108 Dim reponse As MsgBoxResult
109 reponse = MsgBox("Le fichier *MAGIC.SLDPRT est déjà ouvert. Désirez-vous l'écraser (oui) ou quitter l'opération de sauvegarde (non)", MsgBoxStyle.YesNo + MsgBoxStyle.Information, "Fichier déjà ouvert : " & nomfichier2)
110
111 If reponse = MsgBoxResult.Yes Then
112 swApp.CloseDoc(nomfichier2) ' pour fermer le document
113 swModel.SaveAs4(nomfichier2, SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent + SwConst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
114 Else
115 Exit Sub
116 End If
117
118 ElseIf errors <> 0 Then
119 MsgBox("Le fichier MAGiC est déjà ouvert, accès impossible. Veillez fermer le fichier et recommencer", MsgBoxStyle.Exclamation, "Opération annulée")
120 Exit Sub
121 End If
122
123
124 Commun.ColorerAretes()
125 Commun.GenererListes()
126 If decoupe Then ' cette procédure est appelée 2 fois, on ne doit pas faire les 2 ensemble...
127 Try
128 Intersections.Debuter(nomfichier2, nomFichier, checkboxOriginal.Checked, checkboxModifie.Checked)
129 Catch
130 If MsgBox("Debuter n'a pas fonctionner" & vbCr & "Quitter?", MsgBoxStyle.YesNo, "Quitter le calcul") = MsgBoxResult.Yes Then Exit Sub
131 End Try
132 End If
133
134 'If MsgBox("Continuer", MsgBoxStyle.YesNo) = MsgBoxResult.No Then Exit Sub
135
136 Commun.videliste()
137 Commun.GenererListes()
138 tempsTraitement = My.Computer.Clock.TickCount - temps
139 temps = My.Computer.Clock.TickCount
140 Try
141 If decoupe Then Intersections.FairePreCarte()
142 Catch
143 MsgBox("Faire pré-carte n'a pas fonctionner")
144 End Try
145
146 Commun.MettreNoms() ' place les noms des SlyClasses sur les entités.
147 If decoupe Then Fusion() ' met un attribut sur les sommets et arètes doubles (pour que MAGiC ne les maille pas 2 fois.
148 swModel.Save3(swconst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
149
150
151
152 If vcheckboxOriginal And vcheckboxModifie Then
153 ' on veut garder le modèle modifié et faire apparaitre le modèle original
154 swApp.OpenDoc6(nomFichier, swconst.swDocumentTypes_e.swDocPART, 0, 0, errors, warnings)
155
156 ElseIf vcheckboxOriginal And Not vcheckboxModifie Then
157 ' on veut recharger le modèle original et cacher le model modifié
158 swModel.ReloadOrReplace(False, nomFichier, True)
159
160 ElseIf Not vcheckboxOriginal And vcheckboxModifie Then
161 ' on veut garder le modèle modifié uniquement,(déjà fait)
162
163 Else
164 ' on ne veut aucuns modèles, donc on cache tout!
165 'swModel.Close()
166 swApp.CloseDoc(nomfichier2)
167 End If
168
169 PogAutomatique = False
170 POGManuel = False
171 decoupe = False
172 tempsFusion = My.Computer.Clock.TickCount - temps
173 MsgBox("Enregistrement terminé!" & vbCr & vbCr & "Dans un temps de traitement de " & tempsTraitement & " Millisecondes" & vbCr & " Et un temps de fusion de " & tempsFusion & " Millisecondes", MsgBoxStyle.Exclamation)
174
175 End Sub
176
177
178 Public Sub cancel()
179 ' on vient de cliquer sur le bouton cancel... au cas où il y aurait une action à prendre
180 'MsgBox("On a cancellé" & vbCr & " On ne fait rien!")
181
182 End Sub
183
184 Private Sub ajouterConstantes()
185
186 Dim coque As SlyFaceCoque
187 Dim poutre As SlyAretePoutre
188
189 For Each coque In Commun.lst_FaceCoque
190 coque.AddConstantes()
191 Next
192
193 For Each poutre In lst_AretePoutre
194 poutre.AddConstantes()
195 Next
196
197
198
199 End Sub
200
201
202 Public Sub MemoriserValeurs()
203 If Groupe3.Checked = True Then EnregistrementCode.decoupe = True
204 If Groupe2.Checked = True Then EnregistrementCode.POGManuel = True
205 If Groupe4.Checked = True Then EnregistrementCode.PogAutomatique = True
206
207 vNumberENG = NumberENG.Value
208 vNumberbox1 = numberbox1.Value
209 vcheckArrondi = checkArrondi.Checked
210 vNumberArrondi = NumberArrondi.Value
211 vcheckRentrant = checkRentrant.Checked
212 vNumberRentrant = NumberRentrant.Value
213 vcheckMatiere = checkMatiere.Checked
214 vNumberMatiere = NumberMatiere.Value
215 vcheckEntites = checkEntites.Checked
216 vNumberentités = Numberentités.Value
217 vCheckEnt = CheckEnt.Checked
218
219 vcheckboxOriginal = checkboxOriginal.Checked
220 vcheckboxModifie = checkboxModifie.Checked
221 ValeurSliderRemi = curseur.Position
222
223 Intersections.MettreMiniPoutresSurFaceInternes = EnregistrementCode.checkboxMiniSurCoque.Checked
224 Intersections.MultiDecoupageCoques = EnregistrementCode.checkboxMultidecoupage.Checked
225
226 End Sub
227
228
229 Private Sub Fusion()
230 ' sub qui identifie les sommets (et arêtes) doubles et qui met un attribut dessus.
231 Dim sP As SlySommetPoutre
232 Dim sP2 As SlySommetPoutre
233 Dim sVol As SlySommetVolume
234 Dim sCoq As SlySommetCoque
235
236
237 REM fusionne les sommets des poutres.....
238 For Each sP In lst_sommetPoutre
239 For Each sVol In lst_SommetVolume
240 If Distance(sP, sVol) < Epsilon Then
241 Dim esom As New SuperSommet(sP.swSommet, True)
242 esom.MettreAttributDoublonSommet(sVol.nom, sVol.swSommet) : esom = Nothing
243 End If
244 Next
245
246 For Each sCoq In lst_SommetCoque
247 If Distance(sP, sCoq) < Epsilon Then
248 Dim esom As New SuperSommet(sP.swSommet)
249 esom.MettreAttributDoublonSommet(sCoq.nom, sCoq.swSommet) : esom = Nothing
250 End If
251 Next
252
253 Dim passe As Boolean = False
254 For Each sP2 In lst_sommetPoutre
255 If passe Then
256 If Distance(sP, sP2) < Epsilon Then
257 Dim esom As New SuperSommet(sP2.swSommet, True)
258 esom.MettreAttributDoublonSommet(sP.nom, sP.swSommet) : esom = Nothing
259 End If
260 End If
261 If sP2 Is sP Then passe = True
262 Next sP2
263 Next sP
264
265 Dim num As Integer
266 ' maintenant les arètes doublons entre les coques et les volumes
267 For Each sAreteCoque3 As SlyAreteCoque In Commun.lst_AreteCoque
268 For Each sAreteVol As SlyAreteVol In Commun.lst_AreteVolume
269 If sAreteCoque3.comparer((sAreteVol)) Then ' arêtes doivent être fusionnées
270 sAreteCoque3.MettreAttributDoublon(num, False, sAreteVol.nom)
271 'sAreteCoque.Colorer(2, 1, 1, 0)
272 num += 1
273 End If
274 Next
275 Next
276
277
278 'Pour les arètes de coques entre elles...
279 Dim sAreteCoque, sAreteCoque2 As SlyAreteCoque
280
281
282 For i As Integer = 0 To Commun.lst_AreteCoque.Count - 2
283 For j As Integer = i + 1 To Commun.lst_AreteCoque.Count - 1
284 sAreteCoque = Commun.lst_AreteCoque.Item(i)
285 sAreteCoque2 = Commun.lst_AreteCoque.Item(j)
286
287 Debug.Print("On essai maintenant " & vbCr & sAreteCoque.nom & vbCr & sAreteCoque2.nom)
288
289 If sAreteCoque.comparer(sAreteCoque2.swArete) Then
290 sAreteCoque.MettreAttributDoublon(num, False, sAreteCoque2.nom)
291 num += 1
292
293 ' on devrait vérifier si les normales des faces sont dans la même direction...
294
295 End If
296
297 Next
298 Next
299
300 ' maintenant les sommets de coque entre eux.
301 Dim sSommetCoque, sSommetCoque2 As SlySommetCoque
302
303 For i As Integer = 0 To Commun.lst_SommetCoque.Count - 2
304 For j As Integer = i + 1 To Commun.lst_SommetCoque.Count - 1
305 sSommetCoque = Commun.lst_SommetCoque.Item(i)
306 sSommetCoque2 = Commun.lst_SommetCoque.Item(j)
307 If sSommetCoque.Comparer(sSommetCoque2.swSommet) Then
308 sSommetCoque.MettreAttributDoublonSommet(sSommetCoque2.nom, sSommetCoque2.swSommet)
309 End If
310 Next
311 Next
312
313
314 End Sub
315
316
317
318 'Private Sub MettreDoublon(ByRef s As SldWorks.Vertex, ByRef NomMaitre As String, ByRef Maitre As SldWorks.Vertex)
319 ' ' on prend le s et on lui met un flag de doublon avec le nom du Maitre.
320
321 ' ' Sub qui place l'attribut de faceinterne sur une face
322 ' Dim attr As SldWorks.Attribute
323 ' Dim ParamMaitre As SldWorks.Parameter
324 ' Dim swent As SldWorks.Entity
325 ' Static no As Integer = 1
326 ' Dim nom As String
327
328 ' ' vérifier, si le NomMaitre a déjà un maitre, il faut retrouver le vrai maitre
329 ' swent = Maitre
330 ' attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0)
331
332 ' If Not attr Is Nothing Then ' le maitre était déjà esclave... faut updater
333 ' Dim p As SldWorks.Parameter
334 ' p = attr.GetParameter("Maitre")
335 ' NomMaitre = p.GetStringValue()
336 ' End If
337
338 ' attr = Nothing
339 ' Dim pt(2) As Double
340 ' pt = s.GetPoint
341
342 ' nom = "DoublonSommet #" & no & " " & NomMaitre
343 ' swent = s
344 ' attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0) ' si l'attribut existe déjà on pointe dessus.
345
346 ' If attr Is Nothing Then attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, s, nom, 0, 2) ' 0 = swThisconfig
347
348 ' While attr Is Nothing
349 ' nom = "Doublon" & CStr(no)
350 ' attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, s, nom, 0, 2)
351 ' no += 1
352 ' End While
353
354 ' ParamMaitre = attr.GetParameter("Maitre")
355 ' ParamMaitre.SetStringValue2(NomMaitre, 2, "") ' swAllConfiguration = 2
356
357 ' GererDossiers("Doublons", nom)
358 ' no += 1
359 'End Sub
360
361 ''' <summary>
362 ''' Sub qui dessine toutes les conditions aux limites
363 ''' </summary>
364 ''' <remarks></remarks>
365 Public Sub dessinerCL()
366 ' 1 - Créé les encapCL
367 Dim e As EncapCL
368 Dim feat As SldWorks.Feature
369
370 feat = swModel.FirstFeature
371
372 While feat IsNot Nothing
373 If feat.GetTypeName = "Attribute" Then
374 If Left(feat.Name, 9) = "Condition" Then
375 e = New EncapCL(feat)
376 e.DessinerToutesConditions()
377 End If
378 End If
379
380 ' 2 - demandes d'afficher.
381 feat = feat.GetNextFeature
382 End While
383 End Sub
384
385
386 End Module
387
388
389 End Namespace