Macro insert a CutList

Macro
1

Hi all

I'm looking to create a VBA macro in SolidWorks to automate the updating of Cut Lists in my drawings.

Here is my background:

  • I often work from already existing drawings with all my views.
  • When I replace the referenced Part with another Part, the Cut List is not automatically updated.

My goal with this macro:

  1. Delete all existing weld lists in the drawing.
  2. Insert a new Cut List based on view 1 of the drawing.
  3. The new table should ideally use a specific template and respect the anchor point defined in the template.

I've tried several approaches with InsertWeldmentTable, InsertWeldmentCutList or InsertWeldmentTableAnnotation, but I always run into 438 or 91 errors, related to view selection or methods not available in VBA.

Could someone help me find a reliable method in VBA to:

  • Delete old Cut Lists
  • Automatically insert the new one on view 1 with the template anchor point

Thank you in advance for your help and advice! :wink:

2

Hello;

Why try to do this update in the drawing when Solidworks allows you to do it automatically in the room?
image
To be associated with " automatic update of the welded part list" in the settings of the Template property of your drawings:

image
image721×546 51.2 KB

=> This should save you a macro...

3

In a room, to check the 2 lines indicated by @Maclane via macro:

Option Explicit

Public swApp As SldWorks.SldWorks
Public swModel As SldWorks.ModelDoc2
Public swPart As SldWorks.PartDoc
Public swBodyFolder As SldWorks.BodyFolder
Public swFeat As SldWorks.Feature

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel.GetType() = swDocumentTypes_e.swDocASSEMBLY Or swModel.GetType() = swDocumentTypes_e.swDocDRAWING Then
Debug.Print "Ne fonctionne que sur une pièce"
Set swModel = Nothing
Set swApp = Nothing
Exit Sub
End If

Set swPart = swModel

Set swFeat = swPart.FirstFeature

While Not swFeat Is Nothing
'Debug.Print ""
'Debug.Print "Nom de l'élément : "; swFeat.Name
'Debug.Print "Type de l'élément : "; swFeat.GetTypeName2
If swFeat.GetTypeName2 = "SolidBodyFolder" Then
    Set swBodyFolder = swFeat.GetSpecificFeature2
    swBodyFolder.SetAutomaticCutList (True)
    swBodyFolder.SetAutomaticUpdate (True)
    swBodyFolder.UpdateCutList
    swBodyFolder.GetAutomaticUpdate
End If
Set swFeat = swFeat.GetNextFeature()
Wend

Set swBodyFolder = Nothing
Set swFeat = Nothing
Set swPart = Nothing
Set swModel = Nothing
Set swApp = Nothing
End Sub
1 Like
4

Hello;

Otherwise the Solidworks API Help offers this type of macro for adding the cutlist in the drawing:

'----------------------------------------------------------------------------
' Preconditions:
' 1. Verify that the specified cut list template exists.
' 2. Open public_documents\samples utorial\weldments\weldment_box2.sldprt.
' 3. Click File > Make Drawing from Part > OK > drag a view onto
'    the sheet > OK.
' 4. Expand the drawing view in the FeatureManager design tree.
' 5. Right-click weldment_box2 and select Open Part(weldment_box2.sldprt).
' 6. Right-click the Cut list folder and click Update Automatically.
' 7. Click Window > weldment_box2 - Sheet1*.
'
' Postconditions:
' 1. Inserts a weldment cut list table.
' 2. Examine the FeatureManager design tree and graphics area.
'
' NOTE: Because this part is used elsewhere, do not save changes.
'----------------------------------------------------------------------------
Option Explicit
Const WeldmentTableTemplate As String = "C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\lang\english\cut list.sldwldtbt"

Sub Main()
  Dim swapp As SldWorks.SldWorks
  Dim oDrawing As DrawingDoc
  Dim swView As View
  Dim WMTable As SldWorks.WeldmentCutListAnnotation

  Set swapp = Application.SldWorks
  Set oDrawing = swapp.ActiveDoc
  Set swView = oDrawing.GetFirstView
  Set swView = swView.GetNextView

  ' Insert the weldment cut list table
  Set WMTable = swView.InsertWeldmentTable(False, 0.1996662889191, 0.1013905859662, swBOMConfigurationAnchor_TopLeft, "Default<As Welded>", WeldmentTableTemplate)
 

  End Sub
1 Like