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, 9 months ago) by bournival
File size:	15590 byte(s)
Log Message:	Projet de these de Sylvain Bournival. Attention projet VB.
#	Content
1	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