Hello SolidWorks,

I am reviewing over a thousand files (Part, Assembly, and Drawing) from a vendor that we outsourced a project.  Our company has a list of custom properties [CP] that we use.  Our Parts and Assemblies use one set of CPs and Drawings use a similar but different set.  The outsource vendor also used their own in-house custom properties.

I am just knowledgeable enough to mesh parts of other people's macros and API to create what I need.  I have no intelligible VB or API experience to truly make sense of things.

My issue is that I now have many CAD files with a hodgepodge of our company's and the vendor's CPs.  It would be unbelievably time consuming to sort through all of them manually.  I found a macro that successfully sorts CPs alphabetically; but I am in need one that sorts the CPs in a specific order and ignores or leaves the rest alone (to be reviewed for pertinent info before being manually deleted).

Is there a way to edit this alphabetically sorting CP macro to attain my goal?  Any and all help would be greatly appreciated!  I thank you in advance for your time and effort!

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swCustPropMgr As SldWorks.CustomPropertyManager

Dim vCustPropNames As Variant

Dim vCustPropVals As Variant

Dim Current As New Collection

Dim Final As New Collection

Dim i As Integer

Dim blnFound As Boolean

Sub main()

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swCustPropMgr = swModel.Extension.CustomPropertyManager(Empty)

    swCustPropMgr.GetAll vCustPropNames, Empty, vCustPropVals

    'Put custom properties in a collection

    For i = 0 To UBound(vCustPropNames)

        Current.Add vCustPropNames(i)

        Current.Add vCustPropVals(i)

    Next i

    'Insertion sort

    Set Final = Nothing

    Do While Current.Count <> 0

        'First cust prop

        If Final.Count = 0 Then

            Final.Add Current.Item(1)

            Final.Add Current.Item(2)

            Current.Remove 1

            Current.Remove 1

        End If

        'Find place in Final collection

        blnFound = False

        For i = 1 To Final.Count Step 2

            If UCase(Current.Item(1)) < UCase(Final.Item(i)) Then

                Final.Add Current.Item(1), , i

                Final.Add Current.Item(2), , , i

                Current.Remove 1

                Current.Remove 1

                blnFound = True

                Exit For

            ElseIf Current.Item(1) = Final.Item(i) Then

                blnFound = True

            End If

        Next i

        If blnFound = False Then

            Final.Add Current.Item(1)

            Final.Add Current.Item(2)

            Current.Remove 1

            Current.Remove 1

        End If

    Loop

    'Delete and re-add custom properties

    For i = 0 To UBound(vCustPropNames)

        swCustPropMgr.Delete vCustPropNames(i)

    Next i

    For i = 1 To Final.Count Step 2

        swCustPropMgr.Add2 Final.Item(i), swCustomInfoText, Final.Item(i + 1)

    Next i

End Sub