REPOS_ERICCA/magicsld/EnregistrementCode.vb

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

Namespace Enregistrement
    Module EnregistrementCode


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

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

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

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

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

        Public NumberENG As SldWorks.PropertyManagerPageNumberbox

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

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

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

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


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

        Public ValeurSliderRemi As Double

        Private vcheckboxOriginal As Boolean
        Private vcheckboxModifie As Boolean

        Public 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(ValeurSliderRemi, limiteur.Value)
            End If


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


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

            ' première sauvegarde pour se débarasser du modèle original
            nomfichier2 = nomfichier2 + "MAGiC" + ".Sldprt"
            swModel.SaveAs4(nomfichier2, SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent + SwConst.swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
            If errors = SwConst.swFileSaveError_e.swFileSaveAsDoNotOverwrite Then
                Dim reponse As MsgBoxResult
                reponse = MsgBox("Le fichier *MAGIC.SLDPRT est déjà ouvert.  Désirez-vous l'écraser (oui) ou quitter l'opération de sauvegarde (non)", MsgBoxStyle.YesNo + MsgBoxStyle.Information, "Fichier déjà ouvert : " & nomfichier2)

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

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


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