4 Replies Latest reply on Aug 9, 2018 4:51 PM by Artem Taturevych

    Editing Custom properties using task manager or VBA directory

    Robert Caste

      I’m using this macro to edit my custom properties for older files. I’ve looked into task manager and want to use this if possible, but not sure how to edit my code so that it’ll open the file from a directory, run the macro, save and close.

      Can anyone help me with adding to this macro? I’ve looked at a few blog posts and help files but I can’t get anything that I add in to work with this.

       

       

      Option Explicit

       

      Dim swApp As SldWorks.SldWorks

      Dim swModel As SldWorks.ModelDoc2

      Dim swCustPropMgr As SldWorks.CustomPropertyManager

       

      Dim vCustPropNames As Variant

      Dim vCustPropTypes As Variant

      Dim vCustPropVals As Variant

       

      Dim colCurrent As New Collection

      Dim colSkip As New Collection

      Dim colMain As New Collection

      Dim bSkip As Boolean

      Dim bDefaultDataType As BooleanP

       

      Sub Main()

      Dim CustProp As CustProp

      Dim curCustProp As CustProp

      Dim i As Integer

       

      'Clean up the collections.

      Set colCurrent = Nothing

      Set colSkip = Nothing

      Set colMain = Nothing

       

      Set swApp = Application.SldWorks

      Set swModel = swApp.ActiveDoc

      Set swCustPropMgr = swModel.Extension.CustomPropertyManager(Empty)

      swCustPropMgr.Delete "REVISION"

      If swModel Is Nothing Then Exit Sub 'Exit macro since no document is open.

       

      Set swCustPropMgr = swModel.Extension.CustomPropertyManager(Empty)

      swCustPropMgr.GetAll vCustPropNames, vCustPropTypes, vCustPropVals

      swCustPropMgr.Delete "REVISION"

      MsgBox " Custom Property data updated."

      If Not IsEmpty(vCustPropNames) Then

          For i = 0 To UBound(vCustPropNames)

              Set CustProp = New CustProp

              CustProp.cpName = vCustPropNames(i)

              CustProp.cpType = vCustPropTypes(i)

              CustProp.cpValue = vCustPropVals(i)

             

              colCurrent.Add CustProp

             

             

          Next

             

      End If

       

      AddMainCustProps 'Add all "main" custom properties to collection colMain with method AddMainCustProps.

       

       

       

      bDefaultDataType = False

       

       

       

       

      Do While colCurrent.Count <> 0

          For i = 1 To colMain.Count

              Set CustProp = colMain.Item(i)

              Set curCustProp = colCurrent.Item(1)

             

              If CustProp.cpName = curCustProp.cpName Then

                  CustProp.cpValue = curCustProp.cpValue

                 

                  If bDefaultDataType = False Then

                      CustProp.cpType = curCustProp.cpType

                  End If

                 

                  colCurrent.Remove 1

                  bSkip = False

                  If colCurrent.Count = 0 Then Exit For

              Else

                  bSkip = True 'bSkip = True If the custom property was NOT in the colMain collection.

              End If

          Next

         

          If bSkip = True Then

              colSkip.Add colCurrent.Item(1)

              colCurrent.Remove 1

          End If

      Loop

       

      If Not IsEmpty(vCustPropNames) Then

          For i = 0 To UBound(vCustPropNames)

              swCustPropMgr.Delete vCustPropNames(i)

          Next i

      End If

         

      For Each CustProp In colMain

          swCustPropMgr.Add2 CustProp.cpName, CustProp.cpType, CustProp.cpValue

      Next

       

      For Each CustProp In colSkip

          swCustPropMgr.Add2 CustProp.cpName, CustProp.cpType, CustProp.cpValue

      Next

       

       

         

      End Sub

       

      Sub AddMainCustProps()

       

       

       

        AddCustProp "ASSEMBLY", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "DESCRIPTION", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "PART NO.", swCustomInfoType_e.swCustomInfoText, "$PRP:""SW-File Name"""

        AddCustProp "MATERIAL", swCustomInfoType_e.swCustomInfoText, """SW-Material@" & Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1) & """"

        AddCustProp "COLOR", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "VENDOR", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "VENDOR PART NO.", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "WEIGHT", swCustomInfoType_e.swCustomInfoText, """SW-Mass@" & Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1) & """"

        AddCustProp "REVISION", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "DRAWN", swCustomInfoType_e.swCustomInfoText, "GH"

        AddCustProp "DRAWN DATE", swCustomInfoType_e.swCustomInfoText, "--/--/2018"

        AddCustProp "UNIT", swCustomInfoType_e.swCustomInfoText, "EA"

        AddCustProp "SOURCE", swCustomInfoType_e.swCustomInfoText, "M(MS),F(MJ),J(PJ),P(PS)"

        AddCustProp "SORTCODE", swCustomInfoType_e.swCustomInfoText, "SPL001"

        AddCustProp "ProdLine", swCustomInfoType_e.swCustomInfoText, "FC"

        AddCustProp "ROUTER", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "COMMENT", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "TOLLERANCE", swCustomInfoType_e.swCustomInfoText, "0.060"

       

      End Sub

       

      Sub AddCustProp(cpName As String, cpType As Long, cpValue As Variant)

          Dim CustProp As CustProp

          Set CustProp = New CustProp

          CustProp.cpName = cpName

          CustProp.cpType = cpType

          CustProp.cpValue = cpValue

          colMain.Add CustProp

      End Sub