Makro zum Entfernen aller Eigenschaften bis auf einige

Macro
1

Hallo ihr alle

 

Ich versuche, alle bis auf einige Eigenschaften in allen PRT-, ASM- und DRW-Datei-@-Konfigurationen zu entfernen.

Ich habe diesen Code gefunden, der alle Eigenschaften in den Konfigurationen entfernt, den ich ein wenig angepasst habe.

Wie schließe ich mehrere Eigenschaften aus? Der Code entfernt eine Variable.

In meinem Fall DESIGNATION_FR, DESIGNATION_UK, CODE_ARTICLE und NUM_PLAN

Option Explizit
Sub main()
Dim swApp als SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swConfig als SldWorks.Configuration
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim vPropNames als Variante
Dim vPropName als Variante
Dim configNames als Variante
Dim configName als Variante
Legen Sie swApp = Application.SldWorks fest
Festlegen von swModel = swApp.ActiveDoc
    
    
    
Wenn swModel nichts ist, dann

swApp.SendMsgToUser2 "Teiledatei öffnen", swMbWarning, swMbOk

Sub beenden

Ende, wenn


Wenn swModel.GetType <> swDocPART dann

swApp.SendMsgToUser2 "Teiledatei öffnen", swMbWarning, swMbOk

Sub beenden

Ende, wenn

configNames = swModel.GetConfigurationNames

Für jeden configName in configNames
Legen Sie swConfig = swModel.GetConfigurationByName(configName) fest
Legen Sie swCustPropMgr = swConfig.CustomPropertyManager fest
vPropNames = swCustPropMgr.GetNames
Für jeden vPropName in vPropNames
Wenn vPropName <> "DESIGNATION_FR", dann
swCustPropMgr.vPropName löschen
Ende, wenn
Nächster
        
Nächster
Ende Sub

 

 

 

Merci d'avance de votre aide

 

Yannick

2

Hallo, versuchen Sie:

Wenn vPropName <> "DESIGNATION_FR" UND vPropName <> "DESIGNATION_UK" UND vPropName <> "CODE_ARTICLE" UND vPropName <> "NUM_PLAN" ist, dann

3

Hallo und danke Jerome,

Es war einfach, es funktioniert perfekt

Ich möchte auch in der @-Konfiguration löschen.

Haben Sie eine Idee, wie ich vorgehen soll?

Yannick

 

4

Ich verstehe nicht ganz, was Sie hier meinen: "Löschen in @ Konfiguration".

5

Ich sprach davon, die Eigenschaften auf der Registerkarte "Anpassen"  zu entfernen, @ es ist für EPDM

 

 

6

 Versuchen Sie Folgendes:

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 „Gefällt mir“
7

Hallo Jerome,

 

Ich habe gerade das Makro getestet, ich habe die Laufzeitfehlermeldung für die Zeile angezeigt

For Each vPropName In vPropNames

 

Wissen Sie, woher das kommen kann?

Yannick

8

Hallo yannick.petit,

Dies kommt wahrscheinlich daher, dass Sie keine Eigenschaften in der betreffenden Konfiguration haben, Sie können einen Test durchführen, indem Sie Folgendes eingeben:

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

Herzliche Grüße

2 „Gefällt mir“
9

Vielen Dank an euch beide für euer Feedback.

Schönen Tag