13 Replies Latest reply on Sep 19, 2018 4:18 PM by Deepak Gupta

    Export weldament properties of each item in a cut list (VBA)

    Ron Mitchell

      Hello, I have about 1,000 files that I need to open and export the entire weldament property list for each item in each drawing.

       

      I found an example in the SolidWorks help files that explains how to export the properties of a specifically selected item on the cut list: 2018 SOLIDWORKS API Help - Get Custom Properties for Weldment Cut-list Item Example (VBA).

       

      However, I cannot figure out how to loop through each item on the list.

       

      Here is a screen shot of my code, highlighting in yellow the line items that I added to the original example.

       

      module1.png

       

      Could you please help fix the code? (I am very fluent with VBA, but cannot quite figure out the SW objects.)

       

      I have consulted:

       

      but cannot figure out how back out the approach from those examples.

       

      Thank you for your help!

        • Re: Export weldament properties of each item in a cut list (VBA)
          Ron Mitchell

          For convenience, I am also pasting in the code that is in the picture above:

           

          '---------------------------------------------------------------

          ' Preconditions:

          ' 1. Open public_documents\samples\tutorial\api\weldment_box3.sldprt.

          ' 2. Click Tools > Options > Document Properties > Weldments >

          '    Rename cut list folders with Description property value > OK.

          ' 3. Right-click Cut list(31) in the FeatureManager design tree

          '    and click Update.

          ' 4. Expand Cut list(31) and click TUBE, SQUARE 30 X 30 X 2.60<1>.

          ' 5. Open the Immediate window

          '

          ' Postconditions:

          ' 1. Gets the custom properties for the selected cut-list item.

          ' 2. Examine the Immediate window.

          '

          ' NOTE: Because the part document is used elsewhere, do not

          ' save changes.

          '----------------------------------------

          Option Explicit

          Sub main()

              Dim swApp As SldWorks.SldWorks

              Dim swModel As SldWorks.ModelDoc2

              Dim swSelMgr As SldWorks.SelectionMgr

              Dim swCutlistItem As SldWorks.Feature

              Dim swCustPropMgr As SldWorks.CustomPropertyManager

              Dim names As Variant

              Dim name As Variant

              Dim textexp As String

              Dim evalval As String

             

              Dim Part As Object

              Dim boolstatus As Boolean

              Dim longstatus As Long, longwarnings As Long

             

              Set swApp = Application.SldWorks

              Set Part = swApp.OpenDoc6("C:\Users\Public\Documents\SOLIDWORKS\SOLIDWORKS 2018\samples\tutorial\api\weldment_box3.sldprt", 1, 0, "", longstatus, longwarnings)

              swApp.ActivateDoc2 "weldment_box3.sldprt", False, longstatus

              boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swWeldmentRenameCutlistDescriptionPropertyValue, 0, True) 'set options to Rename cut list folders with Description property value

              boolstatus = Part.Extension.SelectByID2("Solid Bodies", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0) 'execute update

              boolstatus = Part.Extension.SelectByID2("TUBE, SQUARE 30 X 30 X 2.60<1>", "SUBWELDFOLDER", 0, 0, 0, False, 0, Nothing, 0)

           

           

              Set swModel = swApp.ActiveDoc

              Set swSelMgr = swModel.SelectionManager

              Set swCutlistItem = swSelMgr.GetSelectedObject6(1, 0)

              Set swCustPropMgr = swCutlistItem.CustomPropertyManager

              Debug.Print "Custom properties for selected weldment cut-list item"

              Debug.Print "Number of custom properties = " + CStr(swCustPropMgr.Count)

              Debug.Print "Name", "Text Expression", "Value", "Type"

              names = swCustPropMgr.GetNames

              For Each name In names

                  swCustPropMgr.Get2 name, textexp, evalval

                  Debug.Print name, textexp, evalval, swCustPropMgr.GetType(name)

              Next name

          End Sub

          • Re: Export weldament properties of each item in a cut list (VBA)
            Fifi Riri

            Hello. Try this:

             

            Option Explicit

            Dim swApp As SldWorks.SldWorks

            Dim swPart As SldWorks.ModelDoc2

            Dim featArr As Variant

            Dim feat As Variant

            Dim swFeature As SldWorks.Feature

            Dim swFeatMgr As SldWorks.FeatureManager

            Dim swCustPropMgr As SldWorks.CustomPropertyManager

            Dim names As Variant

            Dim name As Variant

            Dim textexp As String

            Dim evalval As String

            Sub main()

                Set swApp = Application.SldWorks

                Set swPart = swApp.ActiveDoc

                Set swFeatMgr = swPart.FeatureManager

                featArr = swFeatMgr.GetFeatures(True)

                For Each feat In featArr

                  Set swFeature = feat

                  If swFeature.GetType = swSelectType_e.swSelSUBWELDFOLDER Then

                    If swFeature.GetSpecificFeature2.GetBodyCount <> 0 Then

                      Debug.Print swFeature.name

                      Set swCustPropMgr = swFeature.CustomPropertyManager

                      names = swCustPropMgr.GetNames

                      For Each name In names

                        swCustPropMgr.Get2 name, textexp, evalval

                        Debug.Print , name, evalval   ', textexp, swCustPropMgr.GetType(name)

                      Next

                    End If

                  End If

                Next

            End Sub

              • Re: Export weldament properties of each item in a cut list (VBA)
                Ron Mitchell

                Fifi Riri thank you!!!

                 

                I see instead of going ActiveDoc ---> SelectionManager.GetSelectedObject6(1, 0), the new code goes ActiveDoc ---> FeatureManager.GetFeatures and loops through each feature that has the type swSelSUBWELDFOLDER and GetBodyCount greater than 0.

                 

                I execute the macro on the same 'weldment_box3.sldprt' sample file and I get a type mismatch (#13) runtime error on the line "For Each name In names". Adding a watch for the 'names' variable shows that the variable is empty. Also, before throwing up the error, the immediate window prints "Sub-weldment1". The object exists, as the picture shows.

                 

                If I add nest the each name in names loop in the if statement "If names <> Empty Then", the code prints nothing after that first line, not even another feature name.

                 

                What do I need to do to fix this?

                 

                weldment_box3_swCustPropMgr_GetNames.png

                  • Re: Export weldament properties of each item in a cut list (VBA)
                    Fifi Riri

                    My bad, swSelSUBWELDFOLDER can be both a cut-list folder or a sub-weldment folder, but only cut-list folder have properties.

                    so it should be: swFeature.GetTypeName2 = "CutListFolder"

                    instead of: swFeature.GetType = swSelectType_e.swSelSUBWELDFOLDER

                     

                    to test with the part 'weldment_box3.sldprt', you need to right click and select "update" in order to create the cut-list-items and their properties

                     

                    Option Explicit

                    Dim swApp As SldWorks.SldWorks

                    Dim swPart As SldWorks.ModelDoc2

                    Dim featArr As Variant

                    Dim feat As Variant

                    Dim swFeature As SldWorks.Feature

                    Dim swFeatMgr As SldWorks.FeatureManager

                    Dim swCustPropMgr As SldWorks.CustomPropertyManager

                    Dim names As Variant

                    Dim name As Variant

                    Dim textexp As String

                    Dim evalval As String

                    Sub main()

                        Set swApp = Application.SldWorks

                        Set swPart = swApp.ActiveDoc

                        Set swFeatMgr = swPart.FeatureManager

                        featArr = swFeatMgr.GetFeatures(True)

                        For Each feat In featArr

                          Set swFeature = feat

                          If swFeature.GetTypeName2 = "CutListFolder" Then

                            If swFeature.GetSpecificFeature2.GetBodyCount <> 0 Then

                              Debug.Print swFeature.name

                              Set swCustPropMgr = swFeature.CustomPropertyManager

                              names = swCustPropMgr.GetNames

                              For Each name In names

                                swCustPropMgr.Get2 name, textexp, evalval

                                Debug.Print , name, evalval   ', textexp, swCustPropMgr.GetType(name)

                              Next

                            End If

                          End If

                        Next

                    End Sub

                      • Re: Export weldament properties of each item in a cut list (VBA)
                        Deepak Gupta

                        Fifi Riri wrote:


                        to test with the part 'weldment_box3.sldprt', you need to right click and select "update" in order to create the cut-list-items and their properties

                        You can use following bold lines to update the cut list via macro

                         

                        If swFeature.GetSpecificFeature2.GetBodyCount <> 0 Then

                        swFeature.GetSpecificFeature2.UpdateCutList

                        swFeature.GetSpecificFeature2.SetAutomaticCutList True

                        swFeature.GetSpecificFeature2.SetAutomaticUpdate True

                        • Re: Export weldament properties of each item in a cut list (VBA)
                          Ron Mitchell

                          Fifi Riri, works like magic! Thank you! One final small detail ...

                           

                          I have opened the file manually and executed the code, works perfect.

                           

                          I modified the swPart line to

                           

                          Set swPart = swApp.OpenDoc6("C:\Users\Public\Documents\SOLIDWORKS\SOLIDWORKS 2018\samples\tutorial\api\weldment_box3.sldprt", 1, 0, "", longstatus, longwarnings)

                           

                          And then added

                           

                          boolstatus = swPart.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swWeldmentRenameCutlistDescriptionPropertyValue, 0, True)

                           

                          to set options to Rename cut list folders with Description property value.

                           

                          I can run the code no problem with a break on "Set swFeatMgr = swPart.FeatureManager", to allow me to click update on the cut list.

                           

                          I recorded a macro of me right clicking on the cut list and selecting update. I got:

                           

                          boolstatus = Part.Extension.SelectByID2("Solid Bodies", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)

                           

                          I cannot figure out how to get that update setup to work programatically. This is the last frontier. 

                           

                          Deepak Gupta, thank you!

                           

                          For some reason these lines, inside the loop don't work. Is it perhaps because the code has a different name registered in memory before the update operation is executed?

                           

                          I tried moving the lines outside the loop and doing featArr.GetSpecificFeature2 and swFeatMgr.GetSpecificFeature2. Both generate an error on the basis that either object does not have this property.

                           

                          The documentation for GetSpecificFeature2 (2018 SOLIDWORKS API Help - GetSpecificFeature2 Method (IFeature)) states that for other entities selected in the FeatureManager design tree, you must know its interface in advance and cast the return value of ISelectionMgr::GetSelectedObject6 to the correct interface.

                            • Re: Export weldament properties of each item in a cut list (VBA)
                              Deepak Gupta

                              Ron, the codes work for me the loop. Can you share the exact error message OR your updated macro? You may also try the bodyfolder method. Check example codes below:

                               

                              Option Explicit

                              Dim swApp As SldWorks.SldWorks

                              Dim swPart As SldWorks.ModelDoc2

                              Dim featArr As Variant

                              Dim feat As Variant

                              Dim swFeature As SldWorks.Feature

                              Dim swFeatMgr As SldWorks.FeatureManager

                              Dim swBodyFolder As SldWorks.BodyFolder

                               

                              Sub main()

                                  Set swApp = Application.SldWorks

                                  Set swPart = swApp.ActiveDoc

                                  Set swFeatMgr = swPart.FeatureManager

                                  featArr = swFeatMgr.GetFeatures(True)

                                  For Each feat In featArr

                                    Set swFeature = feat

                                    If swFeature.GetTypeName2 = "CutListFolder" Then

                                      If swFeature.GetSpecificFeature2.GetBodyCount <> 0 Then

                                          Set swBodyFolder = swFeature.GetSpecificFeature2

                                          swBodyFolder.UpdateCutList

                                          swBodyFolder.SetAutomaticCutList True

                                          swBodyFolder.SetAutomaticUpdate True

                                      End If

                                    End If

                                  Next

                              End Sub

                                • Re: Export weldament properties of each item in a cut list (VBA)
                                  Ron Mitchell

                                  Deepak Gupta, unfortunately it does not work still.

                                   

                                  What I stated above was not precisely correct. I did run the code as you show above and it would execute, but it would produce no output. I tested the execution, the code  satisfies the condition "If swFeature.GetTypeName2 = "CutListFolder" Then".

                                   

                                  If I put a break at Set swFeatMgr = swPart.FeatureManager and manually update the cut list, the code executes no problem. (No errors and expected output.)

                                   

                                  However, if I move the update statements to right below "Set swFeature = feat" and right above "If swFeature.GetTypeName2 = "CutListFolder" Then", I get an error. The line "swBodyFolder.UpdateCutList" generates run-time error 91, "Object variable or With block variable not set".

                                   

                                  This code runs, but produces no output whatsoever:

                                   

                                  Option Explicit

                                  Sub main()

                                   

                                  Dim swApp As SldWorks.SldWorks

                                  Dim swPart As SldWorks.ModelDoc2

                                  Dim longstatus As Long, longwarnings As Long

                                  Dim boolstatus As Boolean

                                  Dim swFeatMgr As SldWorks.FeatureManager

                                  Dim featArr As Variant, feat As Variant

                                  Dim swFeature As SldWorks.Feature

                                  Dim swBodyFolder As SldWorks.BodyFolder

                                  Dim swCustPropMgr As SldWorks.CustomPropertyManager

                                  Dim names As Variant, name As Variant

                                  Dim textexp As String

                                  Dim evalval As String

                                   

                                  Set swApp = Application.SldWorks

                                  Set swPart = swApp.OpenDoc6("C:\Users\Public\Documents\SOLIDWORKS\SOLIDWORKS 2018\samples\tutorial\api\weldment_box3.sldprt", 1, 0, "", longstatus, longwarnings)

                                  boolstatus = swPart.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swWeldmentRenameCutlistDescriptionPropertyValue, 0, True) 'set options to Rename cut list folders with Description property value
                                  Set swFeatMgr = swPart.FeatureManager

                                  featArr = swFeatMgr.GetFeatures(True)

                                   

                                  For Each feat In featArr

                                     Set swFeature = feat

                                     If swFeature.GetTypeName2 = "CutListFolder" Then

                                    Debug.Print "test"

                                     If swFeature.GetSpecificFeature2.GetBodyCount <> 0 Then

                                     Set swBodyFolder = swFeature.GetSpecificFeature2

                                    swBodyFolder.UpdateCutList

                                    swBodyFolder.SetAutomaticCutList True

                                    swBodyFolder.SetAutomaticUpdate True

                                    Debug.Print swFeature.name

                                     Set swCustPropMgr = swFeature.CustomPropertyManager

                                    names = swCustPropMgr.GetNames

                                     For Each name In names

                                    swCustPropMgr.Get2 name, textexp, evalval

                                    Debug.Print , name, evalval  ', textexp, swCustPropMgr.GetType(name)
                                     Next

                                     End If

                                     End If

                                  Next

                                  Set swPart = Nothing

                                  swApp.CloseDoc "weldment_box3.sldprt"

                                    

                                  End Sub

                                   

                                  This code produces the above mentioned error:

                                   

                                  Option Explicit

                                  Sub main()

                                   

                                  Dim swApp As SldWorks.SldWorks

                                  Dim swPart As SldWorks.ModelDoc2

                                  Dim longstatus As Long, longwarnings As Long

                                  Dim boolstatus As Boolean

                                  Dim swFeatMgr As SldWorks.FeatureManager

                                  Dim featArr As Variant, feat As Variant

                                  Dim swFeature As SldWorks.Feature

                                  Dim swBodyFolder As SldWorks.BodyFolder

                                  Dim swCustPropMgr As SldWorks.CustomPropertyManager

                                  Dim names As Variant, name As Variant

                                  Dim textexp As String

                                  Dim evalval As String

                                   

                                  Set swApp = Application.SldWorks

                                  Set swPart = swApp.OpenDoc6("C:\Users\Public\Documents\SOLIDWORKS\SOLIDWORKS 2018\samples\tutorial\api\weldment_box3.sldprt", 1, 0, "", longstatus, longwarnings)

                                  boolstatus = swPart.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swWeldmentRenameCutlistDescriptionPropertyValue, 0, True) 'set options to Rename cut list folders with Description property value
                                  Set swFeatMgr = swPart.FeatureManager

                                  featArr = swFeatMgr.GetFeatures(True)

                                   

                                  For Each feat In featArr

                                     Set swFeature = feat

                                     Set swBodyFolder = swFeature.GetSpecificFeature2

                                    swBodyFolder.UpdateCutList

                                    swBodyFolder.SetAutomaticCutList True

                                    swBodyFolder.SetAutomaticUpdate True

                                     If swFeature.GetTypeName2 = "CutListFolder" Then

                                    Debug.Print "test"

                                     If swFeature.GetSpecificFeature2.GetBodyCount <> 0 Then

                                    Debug.Print swFeature.name

                                     Set swCustPropMgr = swFeature.CustomPropertyManager

                                    names = swCustPropMgr.GetNames

                                     For Each name In names

                                    swCustPropMgr.Get2 name, textexp, evalval

                                    Debug.Print , name, evalval  ', textexp, swCustPropMgr.GetType(name)
                                     Next

                                     End If

                                     End If

                                  Next

                                  Set swPart = Nothing

                                  swApp.CloseDoc "weldment_box3.sldprt"

                                    

                                  End Sub

                                    • Re: Export weldament properties of each item in a cut list (VBA)
                                      Fifi Riri

                                      Updated the code to: delete the un-necessary sub-weld-folder, update the cut-list-items and rename the created cut-list-item with the DESCRIPTION property

                                       

                                      Each function needs its separate loop because

                                      the subweldfolder needs to be deleted before the cutlistitem update (or the cutlistitem would be inside the subweldfolder)

                                      the featarr must be re-created after the cutlistitem update

                                       

                                      Option Explicit

                                      Dim swApp As SldWorks.SldWorks

                                      Dim swPart As SldWorks.ModelDoc2

                                      Dim featArr As Variant

                                      Dim feat As Variant

                                      Dim swFeature As SldWorks.Feature

                                      Dim swFeatMgr As SldWorks.FeatureManager

                                      Dim swCustPropMgr As SldWorks.CustomPropertyManager

                                      Dim names As Variant

                                      Dim name As Variant

                                      Dim textexp As String

                                      Dim evalval As String

                                      Dim n As Long

                                      Dim boolstatus As Boolean

                                      Sub main()

                                          Set swApp = Application.SldWorks

                                          Set swPart = swApp.ActiveDoc

                                          Set swFeatMgr = swPart.FeatureManager

                                          n = 0

                                          ' delete sub weldment folder

                                          featArr = swFeatMgr.GetFeatures(True)

                                          For Each feat In featArr

                                            Set swFeature = feat

                                            If swFeature.GetTypeName2 = "SubWeldFolder" Then

                                              boolstatus = swPart.Extension.SelectByID2(swFeature.name, "SUBWELDFOLDER", 0, 0, 0, False, 0, Nothing, 0)

                                              swPart.EditDelete

                                            End If

                                          Next

                                        

                                          ' update cut list items

                                          featArr = swFeatMgr.GetFeatures(True)

                                          For Each feat In featArr

                                            Set swFeature = feat

                                            If swFeature.GetTypeName2 = "SolidBodyFolder" Then

                                              swFeature.GetSpecificFeature2.UpdateCutList

                                              swFeature.GetSpecificFeature2.SetAutomaticCutList True

                                              swFeature.GetSpecificFeature2.SetAutomaticUpdate True

                                              Exit For

                                            End If

                                          Next

                                        

                                          featArr = swFeatMgr.GetFeatures(True)

                                          For Each feat In featArr

                                            Set swFeature = feat

                                            If swFeature.GetTypeName2 = "CutListFolder" Then

                                              If swFeature.GetSpecificFeature2.GetBodyCount <> 0 Then

                                                Debug.Print swFeature.name

                                                Set swCustPropMgr = swFeature.CustomPropertyManager

                                                names = swCustPropMgr.GetNames

                                                For Each name In names

                                                  swCustPropMgr.Get2 name, textexp, evalval

                                                  Debug.Print , name, evalval   ', textexp, swCustPropMgr.GetType(name)

                                                  'rename cut-list-item with the "DESCRIPTION" property

                                                  If name = "DESCRIPTION" Then

                                                    n = n + 1 ' add counter to keep the cut-list-item name unique

                                                    swFeature.name = evalval & " - " & n

                                                  End If

                                                Next

                                              End If

                                            End If

                                          Next

                                      End Sub

                                      • Re: Export weldament properties of each item in a cut list (VBA)
                                        Deepak Gupta

                                        As Fifi Riri has stated, that part has a sub weld folder and hence you codes are not producing anything. So either fix the part manually first or use the updated codes to delete the sub weld folder and recreate the cut list.