11 Replies Latest reply on Mar 31, 2017 10:47 AM by Deepak Gupta

    Reorder Custom Properties macro not working in SW2016

    Michael Wade

      Found this great macro on the forums a year or so ago.  Worked great on 2014.  It reorders the custom properties in our older files so that they follow the same order as our templates.  Now when I run it nothing happens, no errors or anything.  All our other macros run just fine after the upgrade to 2016, just not this one.

       

      The references as they currently stand:

       

      Macro References.jpg

       

      The macro:

       

      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 Boolean

       

      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

       

      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

       

      If Not IsEmpty(vCustPropNames) Then

          For i = 0 To UBound(vCustPropNames) 'Get all current custom properties from the file. Add them to collection colCurrent

              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.

      'Edit (Sub) AddMainCustProps if needed.

       

       

      ' Use Default Data Types for custom properties that exist in file?

      ' If bDefaultDatatype is set to True. Means that the macro

      ' strictly use the stated default data type in AddMainCustProps for the main custom properties.

      ' This may give run-time error if the macro is trying to convert text/number to date etc.

      '

      ' If bDefaultDatatype is set to False. The macro will keep the data type

      ' of already existing main custom properties.

      bDefaultDataType = False

       

      Do While colCurrent.Count <> 0

          For i = 1 To colMain.Count

              Set CustProp = colMain.Item(i) 'Set CustProp to the object in collection colMain

              Set curCustProp = colCurrent.Item(1) 'Set curCustProp to the object in collection colCurrent

            

              If CustProp.cpName = curCustProp.cpName Then 'If statment to get current data if any was present.

                  CustProp.cpValue = curCustProp.cpValue 'Push value from current custom property object to main custom property object

                

                  If bDefaultDataType = False Then 'If False, keep current data type.

                      CustProp.cpType = curCustProp.cpType

                  End If

                

                  colCurrent.Remove 1

                  bSkip = False

                  If colCurrent.Count = 0 Then Exit For 'Exit For statement if the colCollection runs out of objects.

              Else

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

              End If

          Next

        

          If bSkip = True Then 'This is a custom property that was not found to be in the colMain collection.

              colSkip.Add colCurrent.Item(1)

              colCurrent.Remove 1

          End If

      Loop

       

      If Not IsEmpty(vCustPropNames) Then

          For i = 0 To UBound(vCustPropNames) 'Delete all current custom properties in the file.

              swCustPropMgr.Delete vCustPropNames(i)

          Next i

      End If

        

      For Each CustProp In colMain 'Add all main custom properties.

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

      Next

       

      For Each CustProp In colSkip 'Add back all non-main custom properties.

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

      Next

       

      swCustPropMgr.GetAll vCustPropNames, vCustPropTypes, vCustPropVals

      For i = 0 To UBound(vCustPropNames)

          'If a custom property is of Date type and empty (shorter than 6 chars) a message will be prompted the user.

          'If a custom property of Date type is empty (or invalid) the document will fail to save.

          'Futher checks of custom property data may be added here with other If statements.

          If vCustPropTypes(i) = SwDmCustomInfoType.swDmCustomInfoDate And Len(vCustPropVals(i)) < 6 Then

              swApp.SendMsgToUser2 "Custom property: " & vCustPropNames(i) & vbNewLine & vbNewLine & _

              "Is of Date format but seems to be empty." & vbNewLine & _

              "It is most likely that the document will fail to save." & vbNewLine & vbNewLine & _

              "Please check the stated custom property if the documents failes to save.", 1, 2

          End If

      Next

        

      End Sub

       

      Sub AddMainCustProps()

      ' Does it look like a mess?! Do not worry...

      ' Change order, add or remove lines as you like. The order is the order that will be in the custom property page (File->Properties) in SW.

      '

      ' Syntax: AddCustProp "Name of custom property", Default data type, "Default value"

      '

      ' Data types:

      ' swCustomInfoType_e.swCustomInfoDate

      ' swCustomInfoType_e.swCustomInfoDouble

      ' swCustomInfoType_e.swCustomInfoNumber

      ' swCustomInfoType_e.swCustomInfoText

      ' swCustomInfoType_e.swCustomInfoUnknown

      ' swCustomInfoType_e.swCustomInfoYesOrNo

       

        AddCustProp "PartNo", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "OldPartNumber", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "Revision", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "Project", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "Title", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "Description", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "StockSize", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "PartDetails", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "Material", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "Weight", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "Component", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "Orientation", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "Class", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "CharacteristicSize", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "AssemblyType", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "Customer", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "DrawnBy", swCustomInfoType_e.swCustomInfoText, ""

        AddCustProp "DrawnDate", swCustomInfoType_e.swCustomInfoDate, ""

       

      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