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

        '

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