Makro do usuwania wszystkich właściwości z wyjątkiem niektórych

Macro
1

Cze wszystkim

 

Chcę usunąć wszystkie oprócz niektórych właściwości we wszystkich konfiguracjach pliku PRT, ASM i DRW @.

Znalazłem ten kod, który usuwa wszystkie właściwości w konfiguracjach, które trochę dostosowałem.

Jak wykluczyć wiele usług? Kod usuwa zmienną.

W moim przypadku DESIGNATION_FR, DESIGNATION_UK, CODE_ARTICLE i NUM_PLAN

Opcja jawna
Sub main()
Dim swApp jako SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swConfig jako SldWorks.Configuration
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim vPropNames jako wariant
Dim vPropName As Variant
Dim configNames As Variant
Dim configName As Variant
Ustaw swApp = Application.SldWorks
Ustaw swModel = swApp.ActiveDoc
    
    
    
Jeśli swModel jest niczym, to

swApp.SendMsgToUser2 "Otwórz plik części", swMbWarning, swMbOk

Wyjdź z subwoofera

Zakończ jeżeli:


Jeśli swModel.GetType <> swDocPART, to

swApp.SendMsgToUser2 "Otwórz plik części", swMbWarning, swMbOk

Wyjdź z subwoofera

Zakończ jeżeli:

configNames = swModel.GetConfigurationNames

Dla każdej nazwy konfiguracji W configNames
Ustaw swConfig = swModel.GetConfigurationByName(configName)
Ustaw swCustPropMgr = swConfig.CustomPropertyManager
vPropNames = swCustPropMgr.GetNames
Dla każdej nazwy vPropName w vPropNames
Jeśli vPropName <> "DESIGNATION_FR", to
swCustPropMgr.Delete vPropName
Zakończ jeżeli:
Następny
        
Następny
Koniec subwoofera

 

 

 

Merci d'avance de votre aide

 

Yannick

2

Witam, spróbuj:

Jeśli vPropName <> "DESIGNATION_FR" AND vPropName <> "DESIGNATION_UK" AND vPropName <> "CODE_ARTICLE" AND vPropName <> "NUM_PLAN" , to

3

Witam i dziękuję Jerome,

To było proste, działa idealnie

Szukam też do usunięcia w konfiguracji @.

Masz pomysł, jak postępować?

Yannicka

 

4

Nie do końca rozumiem, co masz na myśli: "usuń w konfiguracji @".

5

Mówiłem o usunięciu właściwości w zakładce "Dostosuj" , @ to dla EPDM

 

 

6

 Spróbuj tego:

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

Witaj Hieronim,

 

Właśnie przetestowałem makro, dla wiersza wyświetlany jest komunikat o błędzie w czasie wykonywania

For Each vPropName In vPropNames

 

Czy wiesz, skąd to może pochodzić?

Yannicka

8

Witaj yannick.petit,

Prawdopodobnie wynika to z faktu, że nie masz żadnych właściwości w danej konfiguracji, możesz zrobić test, wpisując:

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

Pozdrowienia

2 polubienia
9

Dziękujemy Wam obojgu za opinie.

Miłego dnia