19 Replies Latest reply on Apr 13, 2015 12:51 PM by Wes Cox

    Delete Empty Property Names

    JOHN GEORGE

      Hi,

      I looked thru the API examples to find a way to delete the empty property names from custom and configuration specific properties and couldn't find one.

      Can someone write a macro to go thru the properties and delete the empty ones?

      Please see the attached picture

       

      delete-properties.png

      I wanted to delete all Names except 2 & 5

       

      Thanks in advance

      JOHN

        • Re: Delete Empty Property Names
          Daniel Andersson

          Hello John,

           

          Try this...

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

          Dim swCustMgr As SldWorks.CustomPropertyManager

           

          Dim vCustNames As Variant

          Dim vCustTypes As Variant

          Dim vCustVals As Variant

           

          Sub main()

           

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

           

          If swModel Is Nothing Then Exit Sub

           

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

           

          swCustMgr.GetAll vCustNames, vCustTypes, vCustVals

           

          For i = 0 To UBound(vCustNames)

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

          Next

           

          End Sub

          Note that this macro will not process and configuration specific custom properties.

            • Re: Delete Empty Property Names
              JOHN GEORGE

              Daniel,

              Thanks for the quick reply

              I tried the macro and it didn't work

              Am I doing something wrong?

              Please see attached

                • Re: Delete Empty Property Names
                  Daniel Andersson

                  I tested the macro on SW2012 and I now see that you are running SW2015. There was new methods introduced in SW2014 but usually the macros still work even if the previous methods is obsolete. I'm currently not able to test at SW2014 (have not installed SW2015).

                   

                  Just one thing first, are you sure that the custom properties is completly empty and do not contain any space? " "

                  I have modified the macro a bit so you can watch if the custom property contain any characters, the information is printed in the immediate window in the VBA editor. The No. chars.: should be 0 (zero) if the custom property is empty.

                   

                  Dim swApp As SldWorks.SldWorks

                  Dim swModel As SldWorks.ModelDoc2

                  Dim swCustMgr As SldWorks.CustomPropertyManager

                   

                  Dim vCustNames As Variant

                  Dim vCustTypes As Variant

                  Dim vCustVals As Variant

                   

                  Sub main()

                   

                  Set swApp = Application.SldWorks

                  Set swModel = swApp.ActiveDoc

                   

                  If swModel Is Nothing Then Exit Sub

                   

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

                   

                  swCustMgr.GetAll vCustNames, vCustTypes, vCustVals

                   

                  For i = 0 To UBound(vCustNames)

                     Debug.Print "Property: " & vCustNames(i) & " - No. chars.: " & Len(vCustVals(i)) 'Added this line

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

                  Next

                   

                  End Sub

                    • Re: Delete Empty Property Names
                      JOHN GEORGE

                      Daniel,

                      Thanks!

                      Most of the empty properties had spaces without characters

                      Now it is working

                        • Re: Delete Empty Property Names
                          Daniel Andersson

                          Happy to hear that it was easy to find the reason. The macro can be edited to remove custom properties that only contain spaces as well.

                            • Re: Delete Empty Property Names
                              JOHN GEORGE

                              It was all with empty spaces.

                              I really appreciate if you could modify the macro to remove properties which contain spaces as well.

                              Is it possible to do the same on configuration specific properties?

                               

                              Thanks,

                              JOHN

                                • Re: Delete Empty Property Names
                                  Daniel Andersson

                                  Hi,

                                   

                                  This macro deletes all custom properties that is empty or only have spaces, it will do it for the configuration specific properties as well. Try it around a bit and let me know if you find out any bugs / strange behaviour.

                                   

                                  // Daniel

                                   

                                  Dim swApp As SldWorks.SldWorks

                                  Dim swModel As SldWorks.ModelDoc2

                                  Dim swCustMgr As SldWorks.CustomPropertyManager

                                   

                                  Dim vConfigurations As Variant

                                  Dim vCustNames As Variant

                                  Dim vCustTypes As Variant

                                  Dim vCustVals As Variant

                                   

                                  Sub main()

                                   

                                  Set swApp = Application.SldWorks

                                  Set swModel = swApp.ActiveDoc

                                   

                                  If swModel Is Nothing Then Exit Sub

                                   

                                  vConfigurations = swModel.GetConfigurationNames

                                   

                                  ReDim Preserve vConfigurations(UBound(vConfigurations) + 1)

                                  vConfigurations(UBound(vConfigurations)) = ""

                                   

                                  For i = 0 To UBound(vConfigurations)

                                      Set swCustMgr = swModel.Extension.CustomPropertyManager(vConfigurations(i))

                                      

                                      swCustMgr.GetAll vCustNames, vCustTypes, vCustVals

                                     

                                      If isArrayEmpty(vCustNames) = False Then

                                          For j = 0 To UBound(vCustNames)

                                             If Len(Trim(vCustVals(j))) = 0 Then swCustMgr.Delete (vCustNames(j))

                                          Next

                                      End If

                                  Next

                                  End Sub

                                   

                                  Public Function isArrayEmpty(parArray As Variant) As Boolean

                                   

                                    If IsArray(parArray) = False Then isArrayEmpty = True

                                    On Error Resume Next

                                    If UBound(parArray) < LBound(parArray) Then isArrayEmpty = True: Exit Function Else: isArrayEmpty = False

                                   

                                  End Function

                                  1 person found this helpful
                            • Re: Delete Empty Property Names
                              Wes Cox

                              Daniel Andersson

                              Deepak Gupta

                              I've been attempting to splice this function into a batch properties macro by Deepak Gupta in this thread, but haven't been able to get it to work. I don't know what I'm doing with API but sometimes get things to work together, in this case I think I'm close, but can't seem to get it to go.

                               

                              I'm attaching the file here. I'm using 2010. I appreciate any insight into my obvious errors.

                                • Re: Delete Empty Property Names
                                  Deepak Gupta

                                  Wes, I believe the path set up is wrong in your macro. There is option to browse the path but you're also giving it a set path.

                                   

                                  These line should be like below in case you want to select the folder every time

                                       Path = BrowseFolder()

                                      If Path = " Then

                                      MsgBox "Please select the path and try again"

                                      End

                                      Else

                                      Path = Path & "\"

                                      End If

                                   

                                  And in case you want a fixed path, then use

                                      Path = "C:\Properties" 'Change path here

                                      Path = Path & "\"

                                    • Re: Delete Empty Property Names
                                      Wes Cox

                                      Thanks Deepak, I did have an error there, but now I'm getting an error in this section:

                                       

                                      ____________

                                       

                                       

                                      Sub BatchFolder(folder As String, ext As String, ext2 As String, silent As Boolean)

                                       

                                       

                                          If Right(folder, 1) <> "\" Then folder = folder & "\"

                                          ChDir (folder)

                                          Response = Dir(folder)

                                          Do Until Response = ""

                                              swFilename = folder & Response

                                              Debug.Print swFilename

                                              MYext = Right(UCase$(Response), 7)

                                              If MYext = ext Or MYext = ext2 Then 'this is a file type we want, process it

                                                  swDocTypeLong = Switch(MYext = ".SLDPRT", swDocPART, MYext = ".SLDDRW", swDocDRAWING, MYext = ".SLDASM", swDocASSEMBLY, True, -1)

                                                 

                                                  Set swModel = swApp.OpenDoc6(swFilename, swDocTypeLong, swOpenDocOptions_Silent, "", nErrors, nWarnings)

                                                  Set swModelDocExt = swModel.Extension

                                                  vConfigurations = swModel.GetConfigurationNames

                                       

                                      ReDim Preserve vConfigurations(UBound(vConfigurations) + 1)

                                      vConfigurations(UBound(vConfigurations)) = ""

                                       

                                      For i = 0 To UBound(vConfigurations)

                                          Set swCustMgr = swModel.Extension.CustomPropertyManager(vConfigurations(i))

                                         

                                          swCustMgr.GetAll vCustNames, vCustTypes, vCustVals

                                        

                                          If isArrayEmpty(vCustNames) = False Then

                                              For j = 0 To UBound(vCustNames)

                                                 If Len(Trim(vCustVals(j))) = 0 Then swCustMgr.Delete (vCustNames(j))

                                              Next

                                          End If

                                      Next

                                      End Sub

                                       

                                       

                                      _____________

                                       

                                      I think I'm at least making a basic problem with how I'm closing the section, like End Sub or something is wrong.


                                      Thank you!

                                        • Re: Delete Empty Property Names
                                          Deepak Gupta

                                          A quick look shows that there are few "end if" missing.

                                           

                                          BTW do you know what error message is being popped up.

                                            • Re: Delete Empty Property Names
                                              Wes Cox

                                              Thanks Deepak,

                                               

                                              I'm getting "Compile error:

                                              Block If without End If"

                                               

                                              I need to pick up a VBA book or something. I try to patch these macros together to get work done without having / taking the time to properly learn basic stuff.

                                               

                                              Thank you for the help.

                                                • Re: Delete Empty Property Names
                                                  Deepak Gupta

                                                  Basically all if conditions needs to be end with end if. So you need to add end if at appropriate position for all if conditions in your macro

                                                    • Re: Delete Empty Property Names
                                                      Wes Cox

                                                      I'm on my 23rd iteration of this macro, still not functioning, but close.

                                                       

                                                      I am trying to get this splice this macro into a macro you created, Deepak, that will allow me to perform this job for a folder of parts.

                                                       

                                                      Here is the one that seems to work best:

                                                       

                                                      Dim swApp As SldWorks.SldWorks

                                                      Dim swModel As SldWorks.ModelDoc2

                                                      Dim swCustMgr As SldWorks.CustomPropertyManager

                                                       

                                                      Dim vConfigurations As Variant

                                                      Dim vCustNames As Variant

                                                      Dim vCustTypes As Variant

                                                      Dim vCustVals As Variant

                                                       

                                                      Sub main()

                                                       

                                                      Set swApp = Application.SldWorks

                                                      Set swModel = swApp.ActiveDoc

                                                       

                                                      If swModel Is Nothing Then Exit Sub

                                                       

                                                      vConfigurations = swModel.GetConfigurationNames

                                                       

                                                      ReDim Preserve vConfigurations(UBound(vConfigurations) + 1)

                                                      vConfigurations(UBound(vConfigurations)) = ""

                                                       

                                                      For i = 0 To UBound(vConfigurations)

                                                          Set swCustMgr = swModel.Extension.CustomPropertyManager(vConfigurations(i))

                                                       

                                                          swCustMgr.GetAll vCustNames, vCustTypes, vCustVals

                                                       

                                                          If isArrayEmpty(vCustNames) = False Then

                                                              For j = 0 To UBound(vCustNames)

                                                                If Len(Trim(vCustVals(j))) = 0 Then swCustMgr.Delete (vCustNames(j))

                                                              Next

                                                          End If

                                                      Next

                                                      End Sub

                                                       

                                                      Public Function isArrayEmpty(parArray As Variant) As Boolean

                                                       

                                                        If IsArray(parArray) = False Then isArrayEmpty = True

                                                        On Error Resume Next

                                                        If UBound(parArray) < LBound(parArray) Then isArrayEmpty = True: Exit Function Else: isArrayEmpty = False

                                                       

                                                      End Function

                                                       

                                                       

                                                       

                                                       

                                                      Here is the batch macro:

                                                       

                                                      'Delete Empty Properties, based on Deepak Gupta Batch Macro, 4.13.2015

                                                       

                                                      Option Explicit

                                                      Private Const BIF_RETURNONLYFSDIRS As Long = &H1

                                                      Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2

                                                      Private Const BIF_RETURNFSANCESTORS As Long = &H8

                                                      Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000

                                                      Private Const BIF_BROWSEFORPRINTER As Long = &H2000

                                                      Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000

                                                      Private Const MAX_PATH As Long = 260

                                                      Function BrowseFolder(Optional Caption As String, _

                                                          Optional InitialFolder As String) As String

                                                       

                                                       

                                                      Dim SH As Shell32.Shell

                                                      Dim F As Shell32.Folder

                                                       

                                                       

                                                      Set SH = New Shell32.Shell

                                                      Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)

                                                      If Not F Is Nothing Then

                                                          BrowseFolder = F.Items.Item.Path

                                                      End If

                                                       

                                                       

                                                      End Function

                                                       

                                                       

                                                      Sub main()

                                                       

                                                       

                                                       

                                                       

                                                       

                                                       

                                                          Dim swApp                      As SldWorks.SldWorks

                                                          Dim swModel                    As SldWorks.modelDoc2

                                                          Dim modelDoc2                  As modelDoc2

                                                          'Dim swModel                    As SldWorks.modelDoc2

                                                          Dim sConfigNameArr              As Variant

                                                          Dim sConfigName                As Variant

                                                          Dim nErrors                    As Long

                                                          Dim nWarnings                  As Long

                                                          Dim sFileName                  As String

                                                          Dim Path                        As String

                                                          Dim boolstatus                  As Boolean

                                                          Dim longstatus                  As Long, longwarnings As Long

                                                          Dim swPart As SldWorks.PartDoc

                                                          Dim Part As SldWorks.PartDoc

                                                          'Dim swConf                      As SldWorks.Configuration

                                                          'Dim swConfMgr                  As SldWorks.ConfigurationManager

                                                          Dim swCustMgr                  As SldWorks.CustomPropertyManager

                                                          Dim swModelView                As SldWorks.ModelView

                                                          Dim vConfigurations As Variant

                                                          Dim vCustNames As Variant

                                                          Dim vCustTypes As Variant

                                                          Dim vCustVals As Variant

                                                       

                                                       

                                                       

                                                          Set swApp = Application.SldWorks

                                                       

                                                          Path = Path & "C:\000\000\000\" 'user specific

                                                       

                                                          

                                                      sFileName = Dir(Path & "*.sldprt") ' Change .sldprt to .sldasm here for assembly

                                                      Do Until sFileName = ""

                                                       

                                                          ' Change swDocPART to swDocAssembly below for assembly

                                                          Set swModel = swApp.OpenDoc6(Path + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings)

                                                       

                                                          Set swPart = swModel

                                                          Set swModelView = swModel.ActiveView

                                                          Set modelDoc2 = swApp.ActiveDoc

                                                       

                                                      'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

                                                       

                                                       

                                                       

                                                       

                                                      'Dim swApp As SldWorks.SldWorks

                                                      'Dim swModel As SldWorks.modelDoc2

                                                      'Dim swCustMgr As SldWorks.CustomPropertyManager

                                                       

                                                      'Dim vConfigurations As Variant

                                                      'Dim vCustNames As Variant

                                                      'Dim vCustTypes As Variant

                                                      'Dim vCustVals As Variant

                                                       

                                                      'Sub main()

                                                       

                                                      'Set swApp = Application.SldWorks

                                                      Set swModel = swApp.ActiveDoc

                                                       

                                                      If swModel Is Nothing Then Exit Sub

                                                       

                                                      vConfigurations = swModel.GetConfigurationNames

                                                       

                                                      ReDim Preserve vConfigurations(UBound(vConfigurations) + 1)

                                                      vConfigurations(UBound(vConfigurations)) = ""

                                                       

                                                      For i = 0 To UBound(vConfigurations)

                                                          Set swCustMgr = swModel.Extension.CustomPropertyManager(vConfigurations(i))

                                                       

                                                          swCustMgr.GetAll vCustNames, vCustTypes, vCustVals

                                                       

                                                          If isArrayEmpty(vCustNames) = False Then

                                                              For j = 0 To UBound(vCustNames)

                                                                If Len(Trim(vCustVals(j))) = 0 Then swCustMgr.Delete (vCustNames(j))

                                                              Next

                                                          End If

                                                      Next

                                                      End Sub

                                                       

                                                      Public Function isArrayEmpty(parArray As Variant) As Boolean

                                                       

                                                        If IsArray(parArray) = False Then isArrayEmpty = True

                                                        On Error Resume Next

                                                        If UBound(parArray) < LBound(parArray) Then isArrayEmpty = True: Exit Function Else: isArrayEmpty = False

                                                       

                                                      End Function

                                                       

                                                      'xxxxxxx

                                                          modelDoc2.GraphicsRedraw

                                                       

                                                          swModel.ForceRebuild3 True 'False

                                                          swModel.ShowNamedView2 "*Dimetric", 9

                                                          swModel.ViewZoomtofit2

                                                          swModel.Save3 swSaveAsOptions_Silent, nErrors, nWarnings

                                                       

                                                      swApp.CloseDoc swModel.GetTitle

                                                      Set swModel = Nothing

                                                      sFileName = Dir

                                                       

                                                      Loop

                                                       

                                                       

                                                       

                                                       

                                                      MsgBox "All Empty Properties Deleted"

                                                       

                                                      End Sub

                                                       

                                                       

                                                       

                                                      I am getting an error for this line:

                                                       

                                                      For i = 0 To UBound(vConfigurations)

                                                       

                                                      Error is "Compile Error: Variable not defined"

                                                       

                                                       

                                                      I've only added the Dims, not eliminated them, so it makes me thing there is a contradiction in this hack job. Do you see anything obvious? I'm so close I think, but can't the mistake that

                                                      s preventing this from running. Thank you!