Macro to remove all but some properties

Macro
1

Hi all

 

I'm looking to remove all but some properties in all PRT, ASM and DRW file @ configurations.

I found this code that removes all the properties in the configurations, which I adapted a bit.

How do I exclude multiple properties? The code removes a variable.

In my case, DESIGNATION_FR, DESIGNATION_UK, CODE_ARTICLE and 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 "Open Part File", swMbWarning, swMbOk

Exit Sub

End If


If swModel.GetType <> swDocPART Then

swApp.SendMsgToUser2 "Open Part File", 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

Hello, try:

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

3

Hello and thank you Jerome,

It was simple, it works perfectly

I'm also looking to delete in the @ configuration.

Any idea how to proceed?

yannick

 

4

I don't quite understand what you mean here: "delete in @ configuration."

5

I was talking about removing the properties in the "Customize"  tab, @ it's for EPDM

 

 

6

 Try this:

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

Hello Jerome,

 

I just tested the macro, I have the runtime error message displayed for the line

For Each vPropName In vPropNames

 

Do you know where this can come from?

yannick

8

Hello yannick.petit,

This probably comes from the fact that you don't have any properties in the config in question, you can do a test by putting:

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

Kind regards

2 Likes
9

Thank you both for your feedback.

Have a nice day