AnsweredAssumed Answered

Clean property script

Question asked by Lasse Nielsen on Aug 29, 2017
Latest reply on Aug 29, 2017 by Michael Dekoning

Hello Forum,

 

I need some help with a macro. I have modified some code from another macro as seen below. I am trying to delete some old and very annoying properties from files located in the vault. Others need renaming due to confusing names. The idea is to run it as a task from the right-click menu.

 

So far the macro opens the file in question, but in read-only mode and thus not able to delete or rename any properties. I somehow need a chunk of code that checks the file out before starting the cleaning process.

 

Hopefully someone can help me out here?

 

 

 

Dim swModel As sldworks.ModelDoc2

Dim swCustPropMgr As SldWorks.CustomPropertyManager

 

Dim Vault As Object

Dim boolProperty As Boolean

 

Sub main()

   

    docFileName = "<Filepath>"

   

    If LCase(Right(docFileName, 7)) = ".sldasm" Then

        Set swApp = Application.SldWorks

        swApp.Visible = True

        OpenAndSave docFileName

        Exit Sub

    Else

        Exit Sub

    End If

 

End Sub

 

 

 

Sub OpenAndSave(docFileName)

    Dim swDocSpecification As SldWorks.DocumentSpecification

   

    'Login to vault

    Set swApp = Application.SldWorks

    Set Vault = CreateObject("ConisioLib.EdmVault.1")

    Vault.Login "Admin", "PW", "VaultName"

   

    'Open file with specifications

    Set swDocSpecification = swApp.GetOpenDocSpec(docFileName)

    swDocSpecification.Silent = True

    swDocSpecification.ConfigurationName = "Default"

    Set swModel = swApp.OpenDoc7(swDocSpecification)

   

    'CheckOut

    'What to do?

   

    'Test deleting property & test renaming property

    Set swCustPropMgr = swModel.Extension.CustomPropertyManager("Default")

   

    swCustPropMgr.Delete2 "Kunde"

   

    Dim strValue As String

    Dim strResolved As String

   

    boolProperty = swCustPropMgr.Get4("DimAfdeling", False, strValue, strResolved)

   

    If boolProperty = True Then

        swCustPropMgr.Delete2 "DimAfdeling"

        swCustPropMgr.Add3 "Department", swCustomInfoText, strValue, 1

    End If

   

    'CheckIn

    'What to do?

   

End Sub

Outcomes