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

# User Rev Content
1 bournival 48 Imports SolidWorks.Interop
2     Imports SolidWorks.Interop.swconst
3     Imports SolidWorks.Interop.swpublished
4    
5 bournival 40 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 bournival 46 Public Groupe4 As SldWorks.PropertyManagerPageGroup
12    
13 bournival 40 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 bournival 48 Public curseur As sldworks.PropertyManagerPageSlider
42 bournival 46 Public limiteur As SldWorks.PropertyManagerPageNumberbox
43 bournival 49 Public labelRemi1 As sldworks.PropertyManagerPageLabel
44 bournival 46
45 bournival 40
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 bournival 50 Public ValeurSliderRemi As Double
59    
60 bournival 40 Private vcheckboxOriginal As Boolean
61     Private vcheckboxModifie As Boolean
62    
63 bournival 130 Public checkboxMiniSurCoque As sldworks.PropertyManagerPageCheckbox
64     Public checkboxMultidecoupage As sldworks.PropertyManagerPageCheckbox
65    
66 bournival 40 Public decoupe As Boolean ' pas le choix, si je met la variable dans le page handler, il plante à la fermeture.
67 bournival 46 Public POGManuel As Boolean
68     Public PogAutomatique As Boolean
69 bournival 40
70    
71 bournival 50
72    
73 bournival 40 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 bournival 130 Dim temps As Integer = My.Computer.Clock.TickCount
83     Dim tempsTraitement As Integer
84     Dim tempsFusion As Integer
85 bournival 40 'Dim NomAppli As String
86    
87 bournival 130 Commun.NomFichierPog = Nothing ' remettre la valeur à 0...
88 bournival 40 If Not sauvegarder Then Return
89 bournival 130 Commun.ÉcartNodal = vNumberENG
90 bournival 48 If POGManuel Then
91 bournival 130 Commun.NomFichierPog = PoGCode.DebutManuel(vNumberENG, Int(vNumberbox1), vcheckArrondi, vNumberArrondi, vcheckRentrant, vNumberRentrant, vcheckMatiere, vNumberMatiere, vcheckEntites, selectionpog, vNumberentités, vCheckEnt)
92 bournival 48 ElseIf PogAutomatique Then
93 bournival 130 Commun.NomFichierPog = PoGCode.DebutAutomatique(ValeurSliderRemi, limiteur.Value)
94 bournival 48 End If
95 bournival 40
96 bournival 46
97 bournival 40 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 bournival 130 If MsgBox("Debuter n'a pas fonctionner" & vbCr & "Quitter?", MsgBoxStyle.YesNo, "Quitter le calcul") = MsgBoxResult.Yes Then Exit Sub
131 bournival 40 End Try
132     End If
133    
134 bournival 130 'If MsgBox("Continuer", MsgBoxStyle.YesNo) = MsgBoxResult.No Then Exit Sub
135    
136 bournival 40 Commun.videliste()
137     Commun.GenererListes()
138 bournival 130 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 bournival 40 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 bournival 130 swModel.Save3(swconst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
149 bournival 40
150    
151    
152     If vcheckboxOriginal And vcheckboxModifie Then
153     ' on veut garder le modèle modifié et faire apparaitre le modèle original
154 bournival 130 swApp.OpenDoc6(nomFichier, swconst.swDocumentTypes_e.swDocPART, 0, 0, errors, warnings)
155 bournival 40
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 bournival 130 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 bournival 40
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 bournival 46 If Groupe2.Checked = True Then EnregistrementCode.POGManuel = True
205     If Groupe4.Checked = True Then EnregistrementCode.PogAutomatique = True
206 bournival 40
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 bournival 130 ValeurSliderRemi = curseur.Position
222 bournival 40
223 bournival 130 Intersections.MettreMiniPoutresSurFaceInternes = EnregistrementCode.checkboxMiniSurCoque.Checked
224     Intersections.MultiDecoupageCoques = EnregistrementCode.checkboxMultidecoupage.Checked
225 bournival 40
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 bournival 130 For Each sAreteCoque3 As SlyAreteCoque In Commun.lst_AreteCoque
268 bournival 40 For Each sAreteVol As SlyAreteVol In Commun.lst_AreteVolume
269 bournival 130 If sAreteCoque3.comparer((sAreteVol)) Then ' arêtes doivent être fusionnées
270     sAreteCoque3.MettreAttributDoublon(num, False, sAreteVol.nom)
271 bournival 40 'sAreteCoque.Colorer(2, 1, 1, 0)
272     num += 1
273     End If
274     Next
275     Next
276    
277    
278 bournival 130 'Pour les arètes de coques entre elles...
279     Dim sAreteCoque, sAreteCoque2 As SlyAreteCoque
280 bournival 40
281    
282 bournival 130 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 bournival 40
287 bournival 130 Debug.Print("On essai maintenant " & vbCr & sAreteCoque.nom & vbCr & sAreteCoque2.nom)
288 bournival 40
289 bournival 130 If sAreteCoque.comparer(sAreteCoque2.swArete) Then
290     sAreteCoque.MettreAttributDoublon(num, False, sAreteCoque2.nom)
291     num += 1
292 bournival 40
293 bournival 130 ' on devrait vérifier si les normales des faces sont dans la même direction...
294 bournival 40
295 bournival 130 End If
296 bournival 40
297 bournival 130 Next
298     Next
299 bournival 40
300 bournival 130 ' maintenant les sommets de coque entre eux.
301     Dim sSommetCoque, sSommetCoque2 As SlySommetCoque
302 bournival 40
303 bournival 130 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 bournival 40
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