Macro om alle eigenschappen te verwijderen, op enkele na

Macro
1

Hoi allemaal

 

Ik ben op zoek naar alle eigenschappen, maar sommige eigenschappen in alle PRT-, ASM- en DRW-bestanden @-configuraties.

Ik heb deze code gevonden die alle eigenschappen in de configuraties verwijdert, die ik een beetje heb aangepast.

Hoe sluit ik meerdere woningen uit? De code verwijdert een variabele.

In mijn geval DESIGNATION_FR, DESIGNATION_UK, CODE_ARTICLE en NUM_PLAN

Optie Expliciete
Sub hoofd()
Dim swApp als SldWorks.SldWorks
Dim swModel als SldWorks.ModelDoc2
Dim swConfig als SldWorks.Configuration
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim vPropNames als variant
Dim vPropName als variant
Dim configNames als variant
Dim configName als variant
Stel swApp = Toepassing.SldWorks in
Stel swModel = swApp.ActiveDoc in
    
    
    
Als swModel niets is, dan

swApp.SendMsgToUser2 "Open onderdeelbestand", swMbWarning, swMbOk

Sub afsluiten

Einde als


Als swModel.GetType <> swDocPART Dan

swApp.SendMsgToUser2 "Open onderdeelbestand", swMbWarning, swMbOk

Sub afsluiten

Einde als

configNames = swModel.GetConfigurationNames

Voor elke configName In configNames
Set swConfig = swModel.GetConfigurationByName(configName)
Stel swCustPropMgr in = swConfig.CustomPropertyManager
vPropNames = swCustPropMgr.GetNames
Voor elke vPropName in vPropNames
Als vPropName "DESIGNATION_FR" <>, dan
swCustPropMgr.Delete vPropName
Einde als
Volgend
        
Volgend
Einde Sub

 

 

 

Merci d'avance de votre aide

 

Yannick

2

Hallo, probeer het eens:

Als vPropName "DESIGNATION_FR" <> EN vPropName <> "DESIGNATION_UK" EN vPropName <> "CODE_ARTICLE" EN vPropName <> "NUM_PLAN" dan

3

Hallo en bedankt Jerome,

Het was eenvoudig, het werkt perfect

Ik ben ook op zoek naar te verwijderen in de @ configuratie.

Enig idee hoe nu verder?

Yannick

 

4

Ik begrijp niet helemaal wat je hier bedoelt: "verwijderen in @ configuratie."

5

Ik had het over het verwijderen van de eigenschappen in het tabblad "Aanpassen",  @ het is voor EPDM

 

 

6

 Probeer het volgende:

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

Hallo Hiëronymus,

 

Ik heb zojuist de macro getest, ik heb de runtime-foutmelding weergegeven voor de lijn

For Each vPropName In vPropNames

 

Weet je waar dit vandaan kan komen?

Yannick

8

Hallo yannick.petit,

Dit komt waarschijnlijk door het feit dat je geen eigenschappen in de betreffende configuratie hebt, je kunt een test doen door te zetten:

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

Vriendelijke groeten

2 likes
9

Dank u beiden voor uw feedback.

Fijne dag