REPOS_ERICCA/magicsld/EnregistrementCode.vb

Imports SolidWorks.Interop
Imports SolidWorks.Interop.swconst
Imports SolidWorks.Interop.swpublished

Namespace Enregistrement
    Module EnregistrementCode


        Public Groupe2 As SldWorks.PropertyManagerPageGroup ' pour la pré-optimisation de maillage
        Public Groupe3 As SldWorks.PropertyManagerPageGroup ' pour le découpage de la géométrie (multidimensionnel)
        Public Groupe4 As SldWorks.PropertyManagerPageGroup

        Public checkboxOriginal As SldWorks.PropertyManagerPageCheckbox
        Public checkboxModifie As SldWorks.PropertyManagerPageCheckbox

        Public checkbox1 As SldWorks.PropertyManagerPageCheckbox
        Public numberbox1 As SldWorks.PropertyManagerPageNumberbox
        Public checkMultimodele As SldWorks.PropertyManagerPageCheckbox

        Public checkArrondi As SldWorks.PropertyManagerPageCheckbox
        Public checkRentrant As SldWorks.PropertyManagerPageCheckbox
        Public checkMatiere As SldWorks.PropertyManagerPageCheckbox

        Public NumberArrondi As SldWorks.PropertyManagerPageNumberbox
        Public NumberRentrant As SldWorks.PropertyManagerPageNumberbox
        Public NumberMatiere As SldWorks.PropertyManagerPageNumberbox

        Public NumberENG As SldWorks.PropertyManagerPageNumberbox

        Public checkEntites As SldWorks.PropertyManagerPageCheckbox
        Public CheckEnt As SldWorks.PropertyManagerPageCheckbox

        Public Numberentités As SldWorks.PropertyManagerPageNumberbox
        Public selectionpog As SldWorks.PropertyManagerPageSelectionbox

        Public Gilles1 As SldWorks.PropertyManagerPageCheckbox
        Public Gilles2 As SldWorks.PropertyManagerPageCheckbox
        Public bGilles1 As Boolean
        Public bGilles2 As Boolean

        Public curseur As sldworks.PropertyManagerPageSlider
        Public limiteur As SldWorks.PropertyManagerPageNumberbox
        Public labelRemi1 As sldworks.PropertyManagerPageLabel


        Private vNumberENG As Double
        Private vNumberbox1 As Double
        Private vcheckArrondi As Boolean
        Private vNumberArrondi As Double
        Private vcheckRentrant As Boolean
        Private vNumberRentrant As Double
        Private vcheckMatiere As Boolean
        Private vNumberMatiere As Double
        Private vcheckEntites As Boolean
        Private vNumberentités As Double
        Private vCheckEnt As Boolean

        Public ValeurSliderRemi As Double

        Private vcheckboxOriginal As Boolean
        Private vcheckboxModifie As Boolean

        Public checkboxMiniSurCoque As sldworks.PropertyManagerPageCheckbox
        Public checkboxMultidecoupage As sldworks.PropertyManagerPageCheckbox
        Public checkboxSectionSimpleSurPoutre As sldworks.PropertyManagerPageCheckbox

        Public decoupe As Boolean ' pas le choix, si je met la variable dans le page handler, il plante à la fermeture.
        Public POGManuel As Boolean
        Public PogAutomatique As Boolean


        Public Lst_BodyCL As New Collection

        Public sauvegarder As Boolean = False

        Public Sub OK()
            Dim errors As Long, warnings As Long  ' on sauvegarde le fichier original
            Dim nomFichier As String
            Dim nomfichier2 As String
            Dim NomFichierPog As String = Nothing
            Dim temps As Integer = My.Computer.Clock.TickCount
            Dim tempsTraitement As Integer
            Dim tempsFusion As Integer
            'Dim NomAppli As String

            Commun.NomFichierPog = Nothing ' remettre la valeur à 0...
            If Not sauvegarder Then Return
            Commun.ÉcartNodal = vNumberENG
            If POGManuel Then
                Commun.NomFichierPog = PoGCode.DebutManuel(vNumberENG, Int(vNumberbox1), vcheckArrondi, vNumberArrondi, vcheckRentrant, vNumberRentrant, vcheckMatiere, vNumberMatiere, vcheckEntites, selectionpog, vNumberentités, vCheckEnt)
            ElseIf PogAutomatique Then
                Commun.NomFichierPog = PoGCode.DebutAutomatique(ValeurSliderRemi, limiteur.Value)
            End If


            swModel.Save3(SwConst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)


            ' on vient de cliquer sur le bouton ok pour enregistrer
            nomFichier = swModel.GetPathName()
            nomfichier2 = Left(nomFichier, Len(nomFichier) - 7)

            ' première sauvegarde pour se débarasser du modèle original
            nomfichier2 = nomfichier2 + "MAGiC" + ".Sldprt"
            swModel.SaveAs4(nomfichier2, SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent + SwConst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
            If errors = SwConst.swFileSaveError_e.swFileSaveAsDoNotOverwrite Then
                Dim reponse As MsgBoxResult
                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)

                If reponse = MsgBoxResult.Yes Then
                    swApp.CloseDoc(nomfichier2) ' pour fermer le document
                    swModel.SaveAs4(nomfichier2, SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent + SwConst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
                Else
                    Exit Sub
                End If

            ElseIf errors <> 0 Then
                MsgBox("Le fichier MAGiC est déjà ouvert, accès impossible. Veillez fermer le fichier et recommencer", MsgBoxStyle.Exclamation, "Opération annulée")
                Exit Sub
            End If


            Commun.ColorerAretes()
            Commun.GenererListes()
            If decoupe Then   ' cette procédure est appelée 2 fois, on ne doit pas faire les 2 ensemble...
                Try
                    Intersections.Debuter(nomfichier2, nomFichier, checkboxOriginal.Checked, checkboxModifie.Checked)
                Catch
                    If MsgBox("Debuter n'a pas fonctionner" & vbCr & "Quitter?", MsgBoxStyle.YesNo, "Quitter le calcul") = MsgBoxResult.Yes Then Exit Sub
                End Try
            End If

            'If MsgBox("Continuer", MsgBoxStyle.YesNo) = MsgBoxResult.No Then Exit Sub

            Commun.videliste()
            Commun.GenererListes()
            tempsTraitement = My.Computer.Clock.TickCount - temps

            Try
                If decoupe Then Intersections.FairePreCarte()
            Catch
                MsgBox("Faire pré-carte n'a pas fonctionner")
            End Try

            temps = My.Computer.Clock.TickCount
            Commun.MettreNoms()  ' place les noms des SlyClasses sur les entités.
            If decoupe Then Fusion() ' met un attribut sur les sommets et arètes doubles (pour que MAGiC ne les maille pas 2 fois.
            swModel.Save3(swconst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)


            If vcheckboxOriginal And vcheckboxModifie Then
                ' on veut garder le modèle modifié et faire apparaitre le modèle original
                swApp.OpenDoc6(nomFichier, swconst.swDocumentTypes_e.swDocPART, 0, 0, errors, warnings)

            ElseIf vcheckboxOriginal And Not vcheckboxModifie Then
                ' on veut recharger le modèle original et cacher le model modifié
                swModel.ReloadOrReplace(False, nomFichier, True)

            ElseIf Not vcheckboxOriginal And vcheckboxModifie Then
                ' on veut garder le modèle modifié uniquement,(déjà fait)

            Else
                ' on ne veut aucuns modèles, donc on cache tout!
                'swModel.Close()
                swApp.CloseDoc(nomfichier2)
            End If

            PogAutomatique = False
            POGManuel = False
            decoupe = False
            tempsFusion = My.Computer.Clock.TickCount - temps
            MsgBox("Enregistrement terminé!" & vbCr & vbCr & "Dans un temps de traitement de " & tempsTraitement & " Millisecondes" & vbCr & " Et un temps de fusion de " & tempsFusion & " Millisecondes", MsgBoxStyle.Exclamation)

        End Sub


        Public Sub cancel()
            ' on vient de cliquer sur le bouton cancel... au cas où il y aurait une action à prendre
            'MsgBox("On a cancellé" & vbCr & " On ne fait rien!")

        End Sub

        Private Sub ajouterConstantes()

            Dim coque As SlyFaceCoque
            Dim poutre As SlyAretePoutre

            For Each coque In Commun.lst_FaceCoque
                coque.AddConstantes()
            Next

            For Each poutre In lst_AretePoutre
                poutre.AddConstantes()
            Next


        End Sub


        Public Sub MemoriserValeurs()
            If Groupe3.Checked = True Then EnregistrementCode.decoupe = True
            If Groupe2.Checked = True Then EnregistrementCode.POGManuel = True
            If Groupe4.Checked = True Then EnregistrementCode.PogAutomatique = True

            vNumberENG = NumberENG.Value
            vNumberbox1 = numberbox1.Value
            vcheckArrondi = checkArrondi.Checked
            vNumberArrondi = NumberArrondi.Value
            vcheckRentrant = checkRentrant.Checked
            vNumberRentrant = NumberRentrant.Value
            vcheckMatiere = checkMatiere.Checked
            vNumberMatiere = NumberMatiere.Value
            vcheckEntites = checkEntites.Checked
            vNumberentités = Numberentités.Value
            vCheckEnt = CheckEnt.Checked

            vcheckboxOriginal = checkboxOriginal.Checked
            vcheckboxModifie = checkboxModifie.Checked
            ValeurSliderRemi = curseur.Position

            Intersections.MettreMiniPoutresSurFaceInternes = EnregistrementCode.checkboxMiniSurCoque.Checked
            Intersections.MultiDecoupageCoques = EnregistrementCode.checkboxMultidecoupage.Checked
            Intersections.SectionSimpleSurPoutre = EnregistrementCode.checkboxSectionSimpleSurPoutre.Checked

        End Sub


        Private Sub Fusion()
            ' sub qui identifie les sommets (et arêtes) doubles et qui met un attribut dessus.
            Dim sP As SlySommetPoutre
            Dim sP2 As SlySommetPoutre
            Dim sVol As SlySommetVolume
            Dim sCoq As SlySommetCoque


            REM fusionne les sommets des poutres.....
            For Each sP In lst_sommetPoutre
                For Each sVol In lst_SommetVolume
                    If Distance(sP, sVol) < Epsilon Then
                        Dim esom As New SuperSommet(sP.swSommet, True)
                        esom.MettreAttributDoublonSommet(sVol.nom, sVol.swSommet) : esom = Nothing
                    End If
                Next

                For Each sCoq In lst_SommetCoque
                    If Distance(sP, sCoq) < Epsilon Then
                        Dim esom As New SuperSommet(sP.swSommet)
                        esom.MettreAttributDoublonSommet(sCoq.nom, sCoq.swSommet) : esom = Nothing
                    End If
                Next

                Dim passe As Boolean = False
                For Each sP2 In lst_sommetPoutre
                    If passe Then
                        If Distance(sP, sP2) < Epsilon Then
                            Dim esom As New SuperSommet(sP2.swSommet, True)
                            esom.MettreAttributDoublonSommet(sP.nom, sP.swSommet) : esom = Nothing
                        End If
                    End If
                    If sP2 Is sP Then passe = True
                Next sP2
            Next sP

            Dim num As Integer
            ' maintenant les arètes doublons entre les coques et les volumes
            For Each sAreteCoque3 As SlyAreteCoque In Commun.lst_AreteCoque
                For Each sAreteVol As SlyAreteVol In Commun.lst_AreteVolume
                    If sAreteCoque3.comparer((sAreteVol)) Then ' arêtes doivent être fusionnées
                        sAreteCoque3.MettreAttributDoublon(num, False, sAreteVol.nom)
                        'sAreteCoque.Colorer(2, 1, 1, 0)
                        num += 1
                    End If
                Next
            Next


            'Pour les arètes de coques entre elles...
            Dim sAreteCoque, sAreteCoque2 As SlyAreteCoque


            For i As Integer = 0 To Commun.lst_AreteCoque.Count - 2
                For j As Integer = i + 1 To Commun.lst_AreteCoque.Count - 1
                    sAreteCoque = Commun.lst_AreteCoque.Item(i)
                    sAreteCoque2 = Commun.lst_AreteCoque.Item(j)

                    Debug.Print("On essai maintenant " & vbCr & sAreteCoque.nom & vbCr & sAreteCoque2.nom)

                    If sAreteCoque.comparer(sAreteCoque2.swArete) Then
                        sAreteCoque.MettreAttributDoublon(num, False, sAreteCoque2.nom)
                        num += 1

                        ' on devrait vérifier si les normales des faces sont dans la même direction...

                    End If

                Next
            Next

            ' maintenant les sommets de coque entre eux.
            Dim sSommetCoque, sSommetCoque2 As SlySommetCoque

            For i As Integer = 0 To Commun.lst_SommetCoque.Count - 2
                For j As Integer = i + 1 To Commun.lst_SommetCoque.Count - 1
                    sSommetCoque = Commun.lst_SommetCoque.Item(i)
                    sSommetCoque2 = Commun.lst_SommetCoque.Item(j)
                    If sSommetCoque.Comparer(sSommetCoque2.swSommet) Then
                        sSommetCoque.MettreAttributDoublonSommet(sSommetCoque2.nom, sSommetCoque2.swSommet)
                    End If
                Next
            Next


        End Sub


        'Private Sub MettreDoublon(ByRef s As SldWorks.Vertex, ByRef NomMaitre As String, ByRef Maitre As SldWorks.Vertex)
        '    ' on prend le s et on lui met un flag de doublon avec le nom du Maitre.

        '    ' Sub qui place l'attribut de faceinterne sur une face
        '    Dim attr As SldWorks.Attribute
        '    Dim ParamMaitre As SldWorks.Parameter
        '    Dim swent As SldWorks.Entity
        '    Static no As Integer = 1
        '    Dim nom As String

        '    ' vérifier, si le NomMaitre a déjà un maitre, il faut retrouver le vrai maitre
        '    swent = Maitre
        '    attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0)

        '    If Not attr Is Nothing Then ' le maitre était déjà esclave... faut updater
        '        Dim p As SldWorks.Parameter
        '        p = attr.GetParameter("Maitre")
        '        NomMaitre = p.GetStringValue()
        '    End If

        '    attr = Nothing
        '    Dim pt(2) As Double
        '    pt = s.GetPoint

        '    nom = "DoublonSommet #" & no & " " & NomMaitre
        '    swent = s
        '    attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0) ' si l'attribut existe déjà on pointe dessus.

        '    If attr Is Nothing Then attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, s, nom, 0, 2) ' 0 = swThisconfig

        '    While attr Is Nothing
        '        nom = "Doublon" & CStr(no)
        '        attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, s, nom, 0, 2)
        '        no += 1
        '    End While

        '    ParamMaitre = attr.GetParameter("Maitre")
        '    ParamMaitre.SetStringValue2(NomMaitre, 2, "")  ' swAllConfiguration = 2

        '    GererDossiers("Doublons", nom)
        '    no += 1
        'End Sub

        ''' <summary>
        ''' Sub qui dessine toutes les conditions aux limites
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub dessinerCL()
            ' 1 - Créé les encapCL
            Dim e As EncapCL
            Dim feat As SldWorks.Feature

            feat = swModel.FirstFeature

            While feat IsNot Nothing
                If feat.GetTypeName = "Attribute" Then
                    If Left(feat.Name, 9) = "Condition" Then
                        e = New EncapCL(feat)
                        e.DessinerToutesConditions()
                    End If
                End If

                ' 2 - demandes d'afficher.
                feat = feat.GetNextFeature
            End While
        End Sub


    End Module


End Namespace
Revision:	205
Committed:	Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size:	16722 byte(s)
Log Message:	Commit de MAGiC_SLD pendant que j'y pense. Les modifications ne devraient pas concerner personne d'autre que moi. -- Sylvain
#	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	bournival	205	Public checkboxSectionSimpleSurPoutre As sldworks.PropertyManagerPageCheckbox
66	bournival	130
67	bournival	40	Public decoupe As Boolean ' pas le choix, si je met la variable dans le page handler, il plante à la fermeture.
68	bournival	46	Public POGManuel As Boolean
69			Public PogAutomatique As Boolean
70	bournival	40
71
72			Public Lst_BodyCL As New Collection
73
74			Public sauvegarder As Boolean = False
75
76			Public Sub OK()
77			Dim errors As Long, warnings As Long ' on sauvegarde le fichier original
78			Dim nomFichier As String
79			Dim nomfichier2 As String
80			Dim NomFichierPog As String = Nothing
81	bournival	130	Dim temps As Integer = My.Computer.Clock.TickCount
82			Dim tempsTraitement As Integer
83			Dim tempsFusion As Integer
84	bournival	40	'Dim NomAppli As String
85
86	bournival	130	Commun.NomFichierPog = Nothing ' remettre la valeur à 0...
87	bournival	40	If Not sauvegarder Then Return
88	bournival	130	Commun.ÉcartNodal = vNumberENG
89	bournival	48	If POGManuel Then
90	bournival	130	Commun.NomFichierPog = PoGCode.DebutManuel(vNumberENG, Int(vNumberbox1), vcheckArrondi, vNumberArrondi, vcheckRentrant, vNumberRentrant, vcheckMatiere, vNumberMatiere, vcheckEntites, selectionpog, vNumberentités, vCheckEnt)
91	bournival	48	ElseIf PogAutomatique Then
92	bournival	130	Commun.NomFichierPog = PoGCode.DebutAutomatique(ValeurSliderRemi, limiteur.Value)
93	bournival	48	End If
94	bournival	40
95	bournival	46
96	bournival	40	swModel.Save3(SwConst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
97
98
99			' on vient de cliquer sur le bouton ok pour enregistrer
100			nomFichier = swModel.GetPathName()
101			nomfichier2 = Left(nomFichier, Len(nomFichier) - 7)
102
103			' première sauvegarde pour se débarasser du modèle original
104			nomfichier2 = nomfichier2 + "MAGiC" + ".Sldprt"
105			swModel.SaveAs4(nomfichier2, SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent + SwConst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
106			If errors = SwConst.swFileSaveError_e.swFileSaveAsDoNotOverwrite Then
107			Dim reponse As MsgBoxResult
108			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)
109
110			If reponse = MsgBoxResult.Yes Then
111			swApp.CloseDoc(nomfichier2) ' pour fermer le document
112			swModel.SaveAs4(nomfichier2, SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent + SwConst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
113			Else
114			Exit Sub
115			End If
116
117			ElseIf errors <> 0 Then
118			MsgBox("Le fichier MAGiC est déjà ouvert, accès impossible. Veillez fermer le fichier et recommencer", MsgBoxStyle.Exclamation, "Opération annulée")
119			Exit Sub
120			End If
121
122
123			Commun.ColorerAretes()
124			Commun.GenererListes()
125			If decoupe Then ' cette procédure est appelée 2 fois, on ne doit pas faire les 2 ensemble...
126			Try
127			Intersections.Debuter(nomfichier2, nomFichier, checkboxOriginal.Checked, checkboxModifie.Checked)
128			Catch
129	bournival	130	If MsgBox("Debuter n'a pas fonctionner" & vbCr & "Quitter?", MsgBoxStyle.YesNo, "Quitter le calcul") = MsgBoxResult.Yes Then Exit Sub
130	bournival	40	End Try
131			End If
132
133	bournival	130	'If MsgBox("Continuer", MsgBoxStyle.YesNo) = MsgBoxResult.No Then Exit Sub
134
135	bournival	40	Commun.videliste()
136			Commun.GenererListes()
137	bournival	130	tempsTraitement = My.Computer.Clock.TickCount - temps
138	bournival	205
139	bournival	130	Try
140			If decoupe Then Intersections.FairePreCarte()
141			Catch
142			MsgBox("Faire pré-carte n'a pas fonctionner")
143			End Try
144
145	bournival	205	temps = My.Computer.Clock.TickCount
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	205	Intersections.SectionSimpleSurPoutre = EnregistrementCode.checkboxSectionSimpleSurPoutre.Checked
226	bournival	40
227			End Sub
228
229
230			Private Sub Fusion()
231			' sub qui identifie les sommets (et arêtes) doubles et qui met un attribut dessus.
232			Dim sP As SlySommetPoutre
233			Dim sP2 As SlySommetPoutre
234			Dim sVol As SlySommetVolume
235			Dim sCoq As SlySommetCoque
236
237
238			REM fusionne les sommets des poutres.....
239			For Each sP In lst_sommetPoutre
240			For Each sVol In lst_SommetVolume
241			If Distance(sP, sVol) < Epsilon Then
242			Dim esom As New SuperSommet(sP.swSommet, True)
243			esom.MettreAttributDoublonSommet(sVol.nom, sVol.swSommet) : esom = Nothing
244			End If
245			Next
246
247			For Each sCoq In lst_SommetCoque
248			If Distance(sP, sCoq) < Epsilon Then
249			Dim esom As New SuperSommet(sP.swSommet)
250			esom.MettreAttributDoublonSommet(sCoq.nom, sCoq.swSommet) : esom = Nothing
251			End If
252			Next
253
254			Dim passe As Boolean = False
255			For Each sP2 In lst_sommetPoutre
256			If passe Then
257			If Distance(sP, sP2) < Epsilon Then
258			Dim esom As New SuperSommet(sP2.swSommet, True)
259			esom.MettreAttributDoublonSommet(sP.nom, sP.swSommet) : esom = Nothing
260			End If
261			End If
262			If sP2 Is sP Then passe = True
263			Next sP2
264			Next sP
265
266			Dim num As Integer
267			' maintenant les arètes doublons entre les coques et les volumes
268	bournival	130	For Each sAreteCoque3 As SlyAreteCoque In Commun.lst_AreteCoque
269	bournival	40	For Each sAreteVol As SlyAreteVol In Commun.lst_AreteVolume
270	bournival	130	If sAreteCoque3.comparer((sAreteVol)) Then ' arêtes doivent être fusionnées
271			sAreteCoque3.MettreAttributDoublon(num, False, sAreteVol.nom)
272	bournival	40	'sAreteCoque.Colorer(2, 1, 1, 0)
273			num += 1
274			End If
275			Next
276			Next
277
278
279	bournival	130	'Pour les arètes de coques entre elles...
280			Dim sAreteCoque, sAreteCoque2 As SlyAreteCoque
281	bournival	40
282
283	bournival	130	For i As Integer = 0 To Commun.lst_AreteCoque.Count - 2
284			For j As Integer = i + 1 To Commun.lst_AreteCoque.Count - 1
285			sAreteCoque = Commun.lst_AreteCoque.Item(i)
286			sAreteCoque2 = Commun.lst_AreteCoque.Item(j)
287	bournival	40
288	bournival	130	Debug.Print("On essai maintenant " & vbCr & sAreteCoque.nom & vbCr & sAreteCoque2.nom)
289	bournival	40
290	bournival	130	If sAreteCoque.comparer(sAreteCoque2.swArete) Then
291			sAreteCoque.MettreAttributDoublon(num, False, sAreteCoque2.nom)
292			num += 1
293	bournival	40
294	bournival	130	' on devrait vérifier si les normales des faces sont dans la même direction...
295	bournival	40
296	bournival	130	End If
297	bournival	40
298	bournival	130	Next
299			Next
300	bournival	40
301	bournival	130	' maintenant les sommets de coque entre eux.
302			Dim sSommetCoque, sSommetCoque2 As SlySommetCoque
303	bournival	40
304	bournival	130	For i As Integer = 0 To Commun.lst_SommetCoque.Count - 2
305			For j As Integer = i + 1 To Commun.lst_SommetCoque.Count - 1
306			sSommetCoque = Commun.lst_SommetCoque.Item(i)
307			sSommetCoque2 = Commun.lst_SommetCoque.Item(j)
308			If sSommetCoque.Comparer(sSommetCoque2.swSommet) Then
309			sSommetCoque.MettreAttributDoublonSommet(sSommetCoque2.nom, sSommetCoque2.swSommet)
310			End If
311			Next
312			Next
313	bournival	40
314
315			End Sub
316
317
318
319			'Private Sub MettreDoublon(ByRef s As SldWorks.Vertex, ByRef NomMaitre As String, ByRef Maitre As SldWorks.Vertex)
320			' ' on prend le s et on lui met un flag de doublon avec le nom du Maitre.
321
322			' ' Sub qui place l'attribut de faceinterne sur une face
323			' Dim attr As SldWorks.Attribute
324			' Dim ParamMaitre As SldWorks.Parameter
325			' Dim swent As SldWorks.Entity
326			' Static no As Integer = 1
327			' Dim nom As String
328
329			' ' vérifier, si le NomMaitre a déjà un maitre, il faut retrouver le vrai maitre
330			' swent = Maitre
331			' attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0)
332
333			' If Not attr Is Nothing Then ' le maitre était déjà esclave... faut updater
334			' Dim p As SldWorks.Parameter
335			' p = attr.GetParameter("Maitre")
336			' NomMaitre = p.GetStringValue()
337			' End If
338
339			' attr = Nothing
340			' Dim pt(2) As Double
341			' pt = s.GetPoint
342
343			' nom = "DoublonSommet #" & no & " " & NomMaitre
344			' swent = s
345			' attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0) ' si l'attribut existe déjà on pointe dessus.
346
347			' If attr Is Nothing Then attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, s, nom, 0, 2) ' 0 = swThisconfig
348
349			' While attr Is Nothing
350			' nom = "Doublon" & CStr(no)
351			' attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, s, nom, 0, 2)
352			' no += 1
353			' End While
354
355			' ParamMaitre = attr.GetParameter("Maitre")
356			' ParamMaitre.SetStringValue2(NomMaitre, 2, "") ' swAllConfiguration = 2
357
358			' GererDossiers("Doublons", nom)
359			' no += 1
360			'End Sub
361
362			''' <summary>
363			''' Sub qui dessine toutes les conditions aux limites
364			''' </summary>
365			''' <remarks></remarks>
366			Public Sub dessinerCL()
367			' 1 - Créé les encapCL
368			Dim e As EncapCL
369			Dim feat As SldWorks.Feature
370
371			feat = swModel.FirstFeature
372
373			While feat IsNot Nothing
374			If feat.GetTypeName = "Attribute" Then
375			If Left(feat.Name, 9) = "Condition" Then
376			e = New EncapCL(feat)
377			e.DessinerToutesConditions()
378			End If
379			End If
380
381			' 2 - demandes d'afficher.
382			feat = feat.GetNextFeature
383			End While
384			End Sub
385
386
387			End Module
388
389
390			End Namespace