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 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

        '

        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 POG 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 POG Then NomFichierPog = PoGCode.debut(vNumberENG, Int(vNumberbox1), vcheckArrondi, vNumberArrondi, vcheckRentrant, vNumberRentrant, vcheckMatiere, vNumberMatiere, vcheckEntites, selectionpog, vNumberentités, vCheckEnt)

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