REPOS_ERICCA/magicsld/EnregistrementCode.vb

Imports SwConst
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 Object
        Public limiteur As SldWorks.PropertyManagerPageNumberbox

        '

        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

        Private vcheckboxOriginal As Boolean
        Private vcheckboxModifie As Boolean

        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 NomAppli As String

            If Not sauvegarder Then Return

            If POGManuel Then NomFichierPog = PoGCode.DebutManuel(vNumberENG, Int(vNumberbox1), vcheckArrondi, vNumberArrondi, vcheckRentrant, vNumberRentrant, vcheckMatiere, vNumberMatiere, vcheckEntites, selectionpog, vNumberentités, vCheckEnt)
            If pogAutomatique Then NomFichierPog = PoGCode.DebutAutomatique(CDbl(curseur.position), limiteur.Value)


            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
                    MsgBox("Debuter n'a pas fonctionner")
                End Try
            End If

            Commun.videliste()
            Commun.GenererListes()
            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


            MsgBox("Enregistrement terminé!", 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


        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 sAreteCoque As SlyAreteCoque In Commun.lst_AreteCoque
                For Each sAreteVol As SlyAreteVol In Commun.lst_AreteVolume
                    If sAreteCoque.Comparer((sAreteVol)) Then ' arętes doivent ętre fusionnées
                        sAreteCoque.MettreAttributDoublon(num, False, sAreteVol.nom)
                        'sAreteCoque.Colorer(2, 1, 1, 0)
                        num += 1
                    End If
                Next
            Next


            ' on parcourt la liste des features et on mémorise les DoublonsA
            'Dim feat As SldWorks.Feature, featMaitre As SldWorks.Feature, featEsclave As SldWorks.Feature
            'Dim vSupprime As Object
            'Dim bsupprime As Boolean
            'Dim NomFeat As String
            'Dim lst_Maitre As New Collections.Generic.Dictionary(Of Integer, SldWorks.Edge)
            'Dim lst_esclave As New Collections.Generic.Dictionary(Of Integer, SldWorks.Edge)

            'Dim attrM As SldWorks.Attribute = Nothing, attrE As SldWorks.Attribute = Nothing
            'Dim swEnt As SldWorks.Entity
            'Dim swAreteMaitre As SldWorks.Edge
            'Dim swAreteEsclave As SldWorks.Edge
            'Dim EncapM As SuperArete
            'Dim EncapE As SuperArete

            'feat = swPart.FirstFeature

            'Do While Not feat Is Nothing

            '    vSupprime = feat.IsSuppressed
            '    bSupprime = CBool(vSupprime)
            '    If Not bSupprime Then  ' on vérifie que l'entité est pas supprimée

            '        NomFeat = feat.Name ' retourne le nom du feature
            '        If Left(NomFeat, 8) = "DoublonA" Then

            '            If InStr(NomFeat, "Maitre") <> 0 Then
            '                attrM = feat.GetSpecificFeature2() : swEnt = attrM.GetEntity() : swAreteMaitre = attrM.GetEntity2()
            '                If Not swAreteMaitre Is Nothing Then lst_Maitre.Add(CInt(Mid(NomFeat, 10, 3)), swAreteMaitre) Else MsgBox("Problčme ŕ trouver l'arčte maitre")

            '            ElseIf InStr(NomFeat, "Esclave") <> 0 Then
            '                attrE = feat.GetSpecificFeature2() : swEnt = attrE.GetEntity() : swAreteEsclave = attrE.GetEntity2()
            '                If Not swAreteEsclave Is Nothing Then lst_esclave.Add(CInt(Mid(NomFeat, 10, 3)), swAreteEsclave) Else MsgBox("Problčme ŕ trouver l'arčte esclave")

            '            End If

            '        End If
            '    End If
            '    feat = feat.GetNextFeature
            'Loop


            'On a 2 listes avec des index identiques pour les entrées ...
            'Dim nomMaitre As String
            'swModel.EditRebuild3()

            'For Each numero As Integer In lst_Maitre.Keys

            '    swAreteMaitre = lst_Maitre.Item(numero)
            '    swAreteEsclave = lst_esclave.Item(numero)

            '    EncapM = New SuperArete(swAreteMaitre, True) : nomMaitre = EncapM.getNom()
            '    EncapE = New SuperArete(swAreteEsclave, True) : Dim effacer As String = EncapE.getNom

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