5 Replies Latest reply on Mar 2, 2018 8:14 PM by Jonathan Westcott

    Macro to Add Prefix to All Custom Properties

    Jonathan Westcott

      I've been looking to build a macro that prefixes ALL custom properties

       

      The purpose of this is related to receiving data from external sources, not wanting to loose them immediately but also not wanting overwrite them when added to PDM (eventually I would like to get this to run as a task in PDM on a transition).

       

      By prefixing them with say "IMPORT-" it will mean the original properties are still in the file but also that they could be easily removed later using another macro if required (by search for properties that contain "IMPORT-").

       

      There seem to be a few macros that get close put aren't quite doing what I'm after.

      I've taken and started to modify a macro by Keith Rice and got very close by just altering one line.

       

       

      'Sort custom properites alphabetically

      'Preconditions: part or assembly is open

      'Written by Keith Rice

      'CADSharp LLC

      'www.cadsharp.com

       

       

      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 "IMPORT- " + Final.Item(i), swCustomInfoText, Final.Item(i + 1)

          Next i

      End Sub

       

       

      This works fine when the number of properties is 0 or greater than 1, then it doesn't work.

      The really isn't much need to sort the properties in this application but I keeps things neat as its so close to working it seems a shame not to continue with this one.

       

      I can write a case to to skip when 0.

       

      What I don't understand is what you can do with a Ubound of 1? Do I need to make a special case for the instance where there is 1 custom property or can't this be altered to accommodate it?

        • Re: Macro to Add Prefix to All Custom Properties
          Ivana Kolin

          use  isempty(vCustPropNames)

              • Re: Macro to Add Prefix to All Custom Properties
                Ivana Kolin

                you need ubound for the loop. If isEmpty(vCustPropNames) then you can exit sub.  Otherwise you can put custom properties in collection, sort, delete and add properties.

                  • Re: Macro to Add Prefix to All Custom Properties
                    Jonathan Westcott

                    Yeah this is great, took me a little while to figure it out but got there in the end. It could probably be done a lot neater than this but at least its working.

                     

                    Thanks for the help!!

                     

                    'Sort custom properites alphabetically

                    'Preconditions: part or assembly is open

                    'Written by Keith Rice

                    'CADSharp LLC

                    'www.cadsharp.com

                     

                    'Modified to add a prefix of "IMPORT-" to custom properties as well a sorting them

                    'Modified by Jon Westcott on 03/03/2018

                     

                    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

                    Dim nNbrProps As Integer

                     

                    Sub main()

                        Set swApp = Application.SldWorks

                        Set swModel = swApp.ActiveDoc

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

                           

                            nNbrProps = swCustPropMgr.Count

                            swCustPropMgr.GetAll vCustPropNames, Empty, vCustPropVals

                            Debug.Print (nNbrProps)

                            If IsEmpty(vCustPropNames) Then GoTo NoProps

                            If nNbrProps = 1 Then GoTo SingleProp

                            If nNbrProps > 1 Then GoTo ManyProps

                           

                    NoProps:

                    Exit Sub

                     

                    SingleProp:

                            For i = 0 To UBound(vCustPropNames)

                            'UBound(vCustPropNames)

                            Current.Add vCustPropNames(i)

                            Current.Add vCustPropVals(i)

                            Next i

                           

                            swCustPropMgr.Delete Current.Item(1)

                            swCustPropMgr.Add2 "IMPORT-" & Current.Item(1), swCustomInfoText, Current.Item(1)

                            Current.Remove 1

                            Current.Remove 1

                            GoTo NoProps

                     

                    ManyProps:

                            'Put custom properties in a collection

                            For i = 0 To UBound(vCustPropNames)

                            '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)

                            'UBound(vCustPropNames)

                                swCustPropMgr.Delete vCustPropNames(i)

                            Next i

                            For i = 1 To Final.Count Step 2

                                swCustPropMgr.Add2 "IMPORT-" & Final.Item(i), swCustomInfoText, Final.Item(i + 1)

                            Next i

                    End Sub

              • Re: Macro to Add Prefix to All Custom Properties
                Fatih Mehmet Ozcan

                Can you try this if it works for you?

                 

                Dim swApp As Object
                Sub main()

                 

                Set swApp = Application.SldWorks

                 

                Dim model As ModelDoc2
                Dim modelextension As ModelDocExtension
                Dim modelcustom As CustomPropertyManager

                 

                Set model = swApp.ActiveDoc
                Set modelextension = model.Extension
                Set modelcustom = modelextension.CustomPropertyManager("")

                 

                Dim customall As Variant
                customall = modelcustom.GetNames
                Dim val As String
                Dim valout As String
                Dim lRetVal As Long
                Dim wasResolved As Boolean
                Dim prefix As String
                prefix = "prefix"

                 

                For Each cus In customall
                    'MsgBox cus
                    lRetVal = modelcustom.Get5(cus, False, val, valout, wasResolved)
                    val = prefix & val
                    lRetVal = modelcustom.Set2(cus, val)
                Next

                 


                End Sub