12 Replies Latest reply on Jan 26, 2016 10:23 AM by Andreas Killer

    Custom Property Conversion Macro help

    Anton Miller

      All,

       

      We are currently converting all of our custom properties to new names.

       

      for example Part_number is now to be DWGNUMBER1

       

      I'm hoping there is an easy way to write a macro to copy the values in the old properties and add them to the new properties.  Also I wish to not delete the old properties incase of any reason we need to use our legacy templates.  The properties do not need to be linked, just copied and pasted.

       

      Thank you for your time and help!

      Anton Miller

        • Re: Custom Property Conversion Macro help
          Andreas Killer

          Hi Anton,

           

          customize the vOldNames and vNewNames arrays for your needs, open the template and run the macro.

           

          Andreas.

           

          Sub CopyProperties()
            Dim swApp As SldWorks.SldWorks
            Dim swModel As SldWorks.ModelDoc2
            Dim CusPropMgr As SldWorks.CustomPropertyManager
            Dim AddStatus As swCustomInfoAddResult_e
            Dim i As Long, j As Long, k As Long
            Dim vOldNames, vNewNames
            Dim vPropNames, Value, Typ

           

            Set swApp = Application.SldWorks
            Set swModel = swApp.ActiveDoc
            Set CusPropMgr = swModel.Extension.CustomPropertyManager("")
           
            'Define arrays with the old and new names
            vOldNames = Array("Material", "Part_number")
            vNewNames = Array("DWGMAT", "DWGNUMBER1")
           
            'Get all properties
            vPropNames = CusPropMgr.GetNames
            For i = LBound(vPropNames) To UBound(vPropNames)
              Value = CusPropMgr.Get(vPropNames(i))
              Typ = CusPropMgr.GetType2(vPropNames(i))
              Debug.Print vPropNames(i)
              'Search for the old names
              For j = LBound(vOldNames) To UBound(vOldNames)
                If StrComp(vPropNames(i), vOldNames(j), vbTextCompare) = 0 Then Exit For
              Next
              'Found?
              If j <= UBound(vOldNames) Then
                'Already exists?
                For k = LBound(vPropNames) To UBound(vPropNames)
                  If StrComp(vPropNames(k), vNewNames(j), vbTextCompare) = 0 Then Exit For
                Next
                If k > UBound(vPropNames) Then
                  'Add the new one
                  AddStatus = CusPropMgr.Add3(vNewNames(j), Typ, Value, True)
                  If AddStatus <> swCustomInfoAddResult_AddedOrChanged Then
                    'Error: Not added!
                    Err.Raise AddStatus
                  End If
                Else
                  'Already exists
                End If
              End If
            Next
          End Sub

            • Re: Custom Property Conversion Macro help
              Anton Miller

              Thank you very much!  this will save us a lot of time.

              • Re: Custom Property Conversion Macro help
                Anton Miller

                Andreas,

                 

                Can you give me some help on how I could modify this to open all parts and assemblies in a specific folder and have this macro run?

                 

                I have tried many of the ways shown on these forums and it has not worked

                 

                Thanks for your time!

                Anton

                  • Re: Custom Property Conversion Macro help
                    Ivana Kolin

                    Anton, if you want to use it for many files, then use Document manager. It is much faster.

                    2015 SOLIDWORKS API Help - Getting Started

                    • Re: Custom Property Conversion Macro help
                      Viktor Bovzdarenko

                      If you want to open all parts and assemblies in a specific folder and have this macro run then you can try: #TASK

                      Drag your folder or parts, drag macro, filter for which files to run macro ("sldprt" for this macro) and press "Run Job". Each part will be opened and macro will be applied.

                       

                      If the folder have thousands of parts then solidworks will restart every 50 files (or as you specify). This will speed up the process. Also SolidWorks will start again if it crashed for any reason.

                       

                       

                      Capture.PNG

                       

                      It is a Beta version of #Task. Central Innovation takes no responsibility of any loss or damage incurred through the use of #TASK. So please, back up your data if you haven’t done so already before running #TASK.

                      • Re: Custom Property Conversion Macro help
                        Andreas Killer

                        Hi Anton,

                         

                        I suggest not to modify the macro, write a 2nd one as shell which opens the files. Code below is not tested!

                         

                        Andreas.

                         

                        Sub OpenFiles()

                          Dim swApp As SldWorks.SldWorks

                          Dim swModel As SldWorks.ModelDoc2

                          Dim FileError As Long

                          Dim FileWarning As Long

                          Dim nDocType As Long

                          Dim Path As String, FName As String

                          Dim Extension As Variant

                         

                          'Setup the path (customize this)

                          Path = "Z:\temp\"

                          'Which kind of file? (customize this)

                          Extension = "sldprt"

                         

                          Select Case LCase(Extension)

                            Case "sldprt"

                              nDocType = swDocPART

                            Case "sldasm"

                              nDocType = swDocASSEMBLY

                            Case "slddrw"

                              nDocType = swDocDRAWING

                            Case Else

                              MsgBox "Unknown extension"

                              Exit Sub

                          End Select

                          'Refer to Solidworks

                          Set swApp = Application.SldWorks

                          'Find the 1st file

                          FName = Dir(Path & "*." & Extension)

                          'Found?

                          Do While FName <> ""

                            'Open the file

                            Set swModel = swApp.OpenDoc6(Path & FName, nDocType, swOpenDocOptions_Silent, "", FileError, FileWarning)

                            'Call the other macro

                            CopyProperties

                            'Close the file

                            swApp.QuitDoc swModel.GetTitle

                            'Find the next file

                            FName = Dir

                          Loop

                        End Sub

                          • Re: Custom Property Conversion Macro help
                            Anton Miller

                            you're brilliant!

                             

                            this is working out extremely well and I thank you very much.  I am on my final round of testing before I go live with this and run on all of our release files.

                             

                            I am running into an error every now and then when the model doesn't have custom properties at all.

                             

                            It fails here:

                             

                            'Get all properties

                              vPropNames = CusPropMgr.GetNames

                            For i = LBound(vPropNames) To UBound(vPropNames)

                                Value = CusPropMgr.Get(vPropNames(i))

                                Typ = CusPropMgr.GetType2(vPropNames(i))

                                Debug.Print vPropNames(i)

                                'Search for the old names

                                For j = LBound(vOldNames) To UBound(vOldNames)

                                  If StrComp(vPropNames(i), vOldNames(j), vbTextCompare) = 0 Then Exit For

                                Next

                             

                            I have been learning a lot over the past week about this programming stuff, but I am still very new, but is there a way to put an argument in the get all properties section to say if no properties then end?

                              • Re: Custom Property Conversion Macro help
                                Viktor Bovzdarenko

                                Should start "For" loop if it has some values

                                for instance: If Not IsEmpty(vPropNames ) Then

                                Try applying this before each loop

                                 

                                 

                                vPropNames = CusPropMgr.GetNames

                                If Not IsEmpty(vPropNames ) Then

                                     For i = LBound(vPropNames) To UBound(vPropNames)

                                         Value = CusPropMgr.Get(vPropNames(i))

                                         Typ = CusPropMgr.GetType2(vPropNames(i))

                                         Debug.Print vPropNames(i)

                                         'Search for the old names

                                If Not IsEmpty(vOldNames) Then

                                         For j = LBound(vOldNames) To UBound(vOldNames)

                                          If StrComp(vPropNames(i), vOldNames(j), vbTextCompare) = 0 Then Exit For

                                    Next

                                End If

                                Next

                                ...

                                End If

                                  • Re: Custom Property Conversion Macro help
                                    Anton Miller

                                    Thanks viktor!

                                     

                                    This does work.  but I did find a slightly better way for our applications as I need to link a new description property to our new Title1, title2, title3

                                     

                                    This is the code I have patched together by using some other examples ive found.  so what I did was added the property description, to be sure it exists then I delete it (cause i couldn't find a way to get the input value to overwrite if anything is there) then add the linking code.  it is working on files from 100- 150 QTY.  but when I try it on around 800 files it does not add the $prp"title2" $prp"title3"  only the title 1 links.

                                     

                                    do you see anything that could be causing this?

                                     

                                    Sub CopyProperties()
                                      Dim swApp As SldWorks.SldWorks
                                      Dim swModel As SldWorks.ModelDoc2
                                      Dim CusPropMgr As SldWorks.CustomPropertyManager
                                      Dim AddStatus As swCustomInfoAddResult_e
                                      Dim i As Long, j As Long, k As Long
                                      Dim vOldNames, vNewNames
                                      Dim vPropNames, Value, Typ

                                     

                                      Set swApp = Application.SldWorks
                                      Set swModel = swApp.ActiveDoc
                                      Set CusPropMgr = swModel.Extension.CustomPropertyManager("")
                                     
                                      'Define arrays with the old and new names
                                      vOldNames = Array("PART_NAME", "Part_number", "FOR", "DATE", "DRAWN_BY", "CHECKED_BY", "NEXT_ASSEMBLY", "REVISION", "FINISH", "HEAT_TREAT", "ANGLES", "CN_NUMBER")
                                      vNewNames = Array("TITLE1", "DWGNUMBER1", "USE", "DATE1", "DRAWNBY1", "CHECKEDBY1", "NEXTASSY1", "REVISION1", "SURFACE", "HEATTREAT", "ANGLE", "EN1")
                                     
                                      swModel.Extension.CustomPropertyManager(Empty).Add2 "DESCRIPTION", swCustomInfoText, " "
                                      swModel.Extension.CustomPropertyManager(Empty).Add2 "TITLE2", swCustomInfoText, " "
                                      swModel.Extension.CustomPropertyManager(Empty).Add2 "TITLE3", swCustomInfoText, " "
                                          Set swCustPropMgr = swModel.Extension.CustomPropertyManager(Empty)
                                        swCustPropMgr.Delete "DESCRIPTION"
                                      swModel.Extension.CustomPropertyManager(Empty).Add2 "DESCRIPTION", swCustomInfoText, "$PRP:" & Chr(34) & "title1" & Chr(34) & " " & "$PRP:" & Chr(34) & "title2" & Chr(34) & " " & "$PRP:" & Chr(34) & "title3" & Chr(34)
                                     
                                      'Get all properties
                                      vPropNames = CusPropMgr.GetNames
                                      For i = LBound(vPropNames) To UBound(vPropNames)
                                        Value = CusPropMgr.Get(vPropNames(i))
                                        Typ = CusPropMgr.GetType2(vPropNames(i))
                                        Debug.Print vPropNames(i)
                                        'Search for the old names
                                        For j = LBound(vOldNames) To UBound(vOldNames)
                                          If StrComp(vPropNames(i), vOldNames(j), vbTextCompare) = 0 Then Exit For
                                        Next
                                        'Found?
                                        If j <= UBound(vOldNames) Then
                                          'Already exists?
                                          For k = LBound(vPropNames) To UBound(vPropNames)
                                            If StrComp(vPropNames(k), vNewNames(j), vbTextCompare) = 0 Then Exit For
                                          Next
                                          If k > UBound(vPropNames) Then
                                            'Add the new one
                                            AddStatus = CusPropMgr.Add3(vNewNames(j), Typ, Value, True)
                                            If AddStatus <> swCustomInfoAddResult_AddedOrChanged Then
                                              'Error: Not added!
                                              Err.Raise AddStatus
                                            End If
                                          Else
                                            'Already exists
                                          End If
                                        End If
                                      Next
                                    End Sub

                                • Re: Custom Property Conversion Macro help
                                  Anton Miller

                                  is there a way to get it to open both .sldprt and .sldasm

                                   

                                  also, I am not sure if its possible, but could this index into subfolders?

                                    • Re: Custom Property Conversion Macro help
                                      Andreas Killer

                                      also, I am not sure if its possible, but could this index into subfolders?

                                      Yes, but for that you need much more code.

                                       

                                      Download this file and import it into your VBProject (that creates a class module FileSearch).
                                      An example how to search for files is available in the comments in the class module.

                                      https://dl.dropboxusercontent.com/u/35239054/FileSearch.cls

                                       

                                      Below is a sample to get you started, untested!

                                       

                                      Andreas.

                                       

                                      Sub Test()

                                        Dim FS As New FileSearch

                                        Dim ThisFile, Extension, nDocType

                                       

                                        With FS

                                          .LookIn = "Z:\"

                                          .FileName = Array("*.sldprt", "*.sldasm")

                                          .SearchSubFolders = True

                                          .Execute

                                          For Each ThisFile In .FoundFiles

                                            'Determine the file type

                                            Extension = Mid(ThisFile, InStrRev(ThisFile, ".") + 1)

                                            Select Case LCase(Extension)

                                              Case "sldprt"

                                                nDocType = swDocPART

                                              Case "sldasm"

                                                nDocType = swDocASSEMBLY

                                              Case "slddrw"

                                                nDocType = swDocDRAWING

                                            End Select

                                       

                                            'Open the file

                                            Set swModel = swApp.OpenDoc6(ThisFile, nDocType, swOpenDocOptions_Silent, "", FileError, FileWarning)

                                            'Call the other macro

                                            CopyProperties

                                            'Close the file

                                            swApp.QuitDoc swModel.GetTitle

                                          Next

                                        End With

                                      End Sub