6 Replies Latest reply on May 25, 2016 9:00 AM by Robert Adair

    Change custom property name in folders & subfolders

    Robert Adair

      Hi all,

       

      My first attempt at any macro API stuff.  I have plagiarized most of this from other posts, and have made it work for the most part.  I am stuck on 2 issues: 1) I would like to to change the custom property of both assemblies (.sldasm) & parts (.sldprt). 2) perform the function not just the folder that I specify, but any subfolders as well. (#TASK is not the answer I am looking for).

      Any help is appreciated.

       

      Dim swApp As SldWorks.SldWorks

      Dim swModel As SldWorks.ModelDoc2

      Dim swCustMgr As SldWorks.CustomPropertyManager

      Dim fileerror As Long

      Dim filewarning As Long

      Dim vCustNames As Variant

      Dim vCustTypes As Variant

      Dim vCustVals As Variant

      Dim PN As String

      Dim OverwriteExisting As Integer

      Dim VAL As Integer

      Dim files As Variant

      Const folder As String = "C:\Users\Radair.QUALITY\Documents\_RAdair Design\Purchased\Advantech\"

       

       

       

      Sub main()

      Set swApp = Application.SldWorks

      files = Dir(folder & "*.sldprt", vbNormal)

      Do While files <> ""

              swApp.OpenDoc6 folder & files, swDocPART, 0, "", fileerror, filewarning

              files = Dir

      Set swModel = swApp.ActiveDoc

      If swModel Is Nothing Then Exit Sub

      'Activate Custom Prop Manager

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

      'Add the new property you want for this is the PartNum

      VAL = swCustMgr.Add3("PartNum", swCustomInfoType_e.swCustomInfoText, "", OverwriteExisting)

      'Now the FOR command will search and find the property you want to delete but first it will store its value under the PN

      'then it will delete the property PartNo

      'Next step will enter the stored value from the deleted property to the new one

      swCustMgr.GetAll vCustNames, vCustTypes, vCustVals

      For i = 0 To UBound(vCustNames)

          If vCustNames(i) = "PartNo" Then PN = (vCustVals(i))

          If vCustNames(i) = "PartNo" Then swCustMgr.Delete (vCustNames(i))

          If vCustNames(i) = "PartNum" Then vCustVals(i) = PN

          VAL = swCustMgr.Set2("PartNum", PN)

      Next

      swModel.Save

      swApp.CloseDoc swModel.GetTitle()

          Loop

      End Sub

        • Re: Change custom property name in folders & subfolders
          Deepak Gupta

          Use the same codes for assembly under the part codes (for keeping it simple). I've removed the other codes to shrink the post. Please replace ****** with your codes

           

          files = Dir(folder & "*.sldprt", vbNormal)

          Do While files <> ""

                  swApp.OpenDoc6 folder & files, swDocPART, 0, "", fileerror, filewarning

          ************     

          Loop

           

          files = Dir(folder & "*.sldasm", vbNormal)

          Do While files <> ""

                  swApp.OpenDoc6 folder & files, swDocASSEMBLY, 0, "", fileerror, filewarning

            ************     

          Loop

          Here you can find codes by Luke for working with files in folders, sub folders https://forum.solidworks.com/message/76355#comment-76355

          (#TASK is not the answer I am looking for).

          Any specific reason you can not use #TASK

            • Re: Change custom property name in folders & subfolders
              Robert Adair

              Deepak,

               

              Thank you for your response.

               

              I tried that before, and I get close, however I have something wrong, as it gives the .sldasm  the same PartNum as whichever .sldprt was opened first.

               

              I probably have something out of order.

               

              Sub main()

              Set swApp = Application.SldWorks

              files = Dir(folder & "*.sldprt", vbNormal)

              Do While files <> ""

              swApp.OpenDoc6 folder & files, swDocPART, 0, "", fileerror, filewarning

              files = Dir

              Set swModel = swApp.ActiveDoc

              If swModel Is Nothing Then Exit Sub

              'Activate Custom Prop Manager

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

              'Add the new property you want for this is the PartNum

              VAL = swCustMgr.Add3("PartNum", swCustomInfoType_e.swCustomInfoText, "", OverwriteExisting)

              'Now the FOR command will search and find the property you want to delete but first it will store its value under the PN

              'then it will delete the property PartNo

              'Next step will enter the stored value from the deleted property to the new one

              1. swCustMgr.GetAll vCustNames, vCustTypes, vCustVals

              For i = 0 To UBound(vCustNames)

              If vCustNames(i) = "PartNo" Then PN = (vCustVals(i))

              If vCustNames(i) = "PartNo" Then swCustMgr.Delete (vCustNames(i))

              If vCustNames(i) = "PartNum" Then vCustVals(i) = PN

              VAL = swCustMgr.Set2("PartNum", PN)

              Next

              1. swModel.Save
              2. swApp.CloseDoc swModel.GetTitle()

              Loop

               

                  files = Dir(folder & "*.sldasm", vbNormal)

              Do While files <> ""

              swApp.OpenDoc6 folder & files, swDocASSEMBLY, 0, "", fileerror, filewarning

              files = Dir

              Set swModel = swApp.ActiveDoc

              If swModel Is Nothing Then Exit Sub

              'Activate Custom Prop Manager

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

              'Add the new property you want for this is the PartNum

              VAL = swCustMgr.Add3("PartNum", swCustomInfoType_e.swCustomInfoText, "", OverwriteExisting)

              'Now the FOR command will search and find the property you want to delete but first it will store its value under the PN

              'then it will delete the property PartNo

              'Next step will enter the stored value from the deleted property to the new one

              1. swCustMgr.GetAll vCustNames, vCustTypes, vCustVals

              For i = 0 To UBound(vCustNames)

              If vCustNames(i) = "PartNo" Then PN = (vCustVals(i))

              If vCustNames(i) = "PartNo" Then swCustMgr.Delete (vCustNames(i))

              If vCustNames(i) = "PartNum" Then vCustVals(i) = PN

              VAL = swCustMgr.Set2("PartNum", PN)

              Next

              1. swModel.Save
              2. swApp.CloseDoc swModel.GetTitle()

              Loop

              End Sub

               

               

              As far as the #TASK, currently very low workload (which allows me time to investigate this), but is preventing spending any funds on additional software, etc.