Macro pour supprimer toutes les propiétés sauf certaines

Macro
1

Bonjour à tous,

 

Je cherche a supprimer toutes  les propriétées sauf certaines , dans toutes les configurations et @ de fichier PRT, ASM et DRW.

J'ai trouvé ce code qui supprime toutes les propriétés dans les configurations, que j'ai adapté un peu.

Comment exclure plusieurs propriétés ? Le code supprime une variable.

Dans mon cas DESIGNATION_FR, DESIGNATION_UK, CODE_ARTICLE et NUM_PLAN

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swConfig As SldWorks.Configuration
    Dim swCustPropMgr As SldWorks.CustomPropertyManager
    Dim vPropNames As Variant
    Dim vPropName As Variant
    Dim configNames As Variant
    Dim configName As Variant
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    
    
If swModel Is Nothing Then

    swApp.SendMsgToUser2 "Ouvrir un fichier pièce", swMbWarning, swMbOk

    Exit Sub

End If


If swModel.GetType <> swDocPART Then

    swApp.SendMsgToUser2 "Ouvrir un fichier pièce", swMbWarning, swMbOk

    Exit Sub

End If

    configNames = swModel.GetConfigurationNames

    For Each configName In configNames
        Set swConfig = swModel.GetConfigurationByName(configName)
        Set swCustPropMgr = swConfig.CustomPropertyManager
        vPropNames = swCustPropMgr.GetNames
        For Each vPropName In vPropNames
        If vPropName <> "DESIGNATION_FR" Then
            swCustPropMgr.Delete vPropName
        End If
        Next
        
    Next
End Sub

 

 

 

Merci d'avance de votre aide

 

Yannick

2

Bonjour, essaye:

If vPropName <> "DESIGNATION_FR" AND vPropName <> "DESIGNATION_UK" AND vPropName <> "CODE_ARTICLE" AND vPropName <> "NUM_PLAN" Then

3

Bonjour et merci Jérome,

C'était simple, ca fonctionne parfaitement

Je cherche également a supprimer dans la configuration @.

Une idée de comment procéder?

yannick

 

4

Je ne comprend pas bien ce que tu veux dire ici: "supprimer dans la configuration @."

5

Je parlais de supprimer les propriétés dans l'onglet "Personnaliser"  , @ c'est pour EPDM

 

 

6

 Essaye ca:

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swConfig As SldWorks.Configuration
    Dim swCustPropMgr As SldWorks.CustomPropertyManager
    Dim vPropNames As Variant
    Dim vPropName As Variant
    Dim configNames As Variant
    Dim configName As Variant
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

    If swModel Is Nothing Then
        swApp.SendMsgToUser2 "Ouvrir un fichier pièce", swMbWarning, swMbOk
        Exit Sub
    End If

    If swModel.GetType <> swDocPART Then
        swApp.SendMsgToUser2 "Ouvrir un fichier pièce", swMbWarning, swMbOk
        Exit Sub
    End If

    Set swCustPropMgr = swModel.Extension.CustomPropertyManager(Empty)
    vPropNames = swCustPropMgr.GetNames
    For Each vPropName In vPropNames
        If vPropName <> "DESIGNATION_FR" AND vPropName <> "DESIGNATION_UK" AND vPropName <> "CODE_ARTICLE" AND vPropName <> "NUM_PLAN" Then
            swCustPropMgr.Delete vPropName
        End If
    Next

    configNames = swModel.GetConfigurationNames
    For Each configName In configNames
        Set swConfig = swModel.GetConfigurationByName(configName)
        Set swCustPropMgr = swConfig.CustomPropertyManager
        vPropNames = swCustPropMgr.GetNames
        For Each vPropName In vPropNames
            If vPropName <> "DESIGNATION_FR" AND vPropName <> "DESIGNATION_UK" AND vPropName <> "CODE_ARTICLE" AND vPropName <> "NUM_PLAN" Then
                swCustPropMgr.Delete vPropName
            End If
        Next
    Next
End Sub

 

1 « J'aime »
7

Bonjour Jérome,

 

Je viens de tester la macro, j'ai le message erreur d'execution qui s'affiche pour la ligne

For Each vPropName In vPropNames

 

Sais tu d'ou cela peut provenir?

yannick

8

Bonjour yannick.petit,

Cela vient probablement du fait que tu n'as aucune propriété dans la config en question, tu peux faire un test en mettant :

If IsEmpty(vPropNames) = False Then
    For Each vPropName In vPropNames
        If vPropName <> "DESIGNATION_FR" And vPropName <> "DESIGNATION_UK" And vPropName <> "CODE_ARTICLE" And vPropName <> "NUM_PLAN" Then
            swCustPropMgr.Delete vPropName
        End If
    Next
End If

Cordialement,

2 « J'aime »
9

Merci a tous les deux pour vos retours.

Bonne journée