AnsweredAssumed Answered

Reorder Custom Properties macro not working in SW2016

Question asked by Michael Wade on Mar 30, 2017
Latest reply on Mar 31, 2017 by Deepak Gupta

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

Attachments

Outcomes