Hi,

     I need a macro to update cutlist to all assembly components... I want to set to open each component, update cutlist and close.

I write this code and it works, but it not run to all components and i don't understand why

''''''''''''''''''''

Sub main()

   Dim swApp                       As SldWorks.SldWorks

   Dim swModel                     As SldWorks.ModelDoc2

   Dim swAssy                      As SldWorks.AssemblyDoc

   Dim swConf                      As SldWorks.Configuration

   Dim swRootComp                  As SldWorks.Component2

   Dim nStart                      As Single

   Dim bRet                        As Boolean

   Set swApp = Application.SldWorks

   Set swModel = swApp.ActiveDoc

   Set swConf = swModel.GetActiveConfiguration

   Set swRootComp = swConf.GetRootComponent3(True)

   Debug.Print "File = " & swModel.GetPathName

   TraverseComponent swRootComp, 1

   Debug.Print "Finished!"

End Sub

Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

Dim vChildComp                  As Variant

   Dim swApp                       As SldWorks.SldWorks

   Dim swpart                      As SldWorks.PartDoc

   Dim swChildComp                 As SldWorks.Component2

   Dim swConfig                    As SldWorks.Configuration

   Dim swConfMgr                   As SldWorks.ConfigurationManager

   Dim swChildModel                As SldWorks.ModelDoc2

   Dim swOpenModel                 As SldWorks.ModelDoc2

   Dim swChildCustPropMngr         As CustomPropertyManager

   Dim swChildModelDocExt          As ModelDocExtension

   Dim swsheetmetal                As SldWorks.SheetMetalFeatureData

   Dim swFeat                      As SldWorks.Feature

   Dim swBody                      As SldWorks.Body2

   Dim Sheet_metal                 As Boolean

   Dim Boolstatus                  As Boolean

   Dim Thickness                   As Double

   Dim conv                        As Double

   Dim i                           As Long

   Dim loptions                    As Long

   Dim lerrors                     As Long

   Dim sPadStr                     As String

   Dim FilePath                    As String

   Dim FileName                    As String

   Dim swThkDir                    As String

   Dim swMatDir                    As String

   Dim swCurrent                   As String

   Dim RefCfg                      As String

   Dim ChildConfigName             As String

   Dim sMatName                    As String

   Dim sMatDB                      As String

   Dim exFileName                  As String

   Dim Bodies                      As Variant

   Dim Number As String

   vChildComp = swComp.GetChildren

   'Dim swFeat As SldWorks.Feature

   Dim swBodyFolder As SldWorks.BodyFolder

   For i = 0 To UBound(vChildComp)

       Set swChildComp = vChildComp(i)

       'Check to see if current component is suppressed

       If swChildComp.IsSuppressed = False Then GoTo Active Else GoTo Skip

Active:

Set swApp = Application.SldWorks

Set swChildModel = swChildComp.GetModelDoc2

   'Check to see if child component is an Assembly or part

   If (swChildModel.GetType <> swDocPART) Then GoTo Jump 'Skips Subassemby level

Set swpart = swChildModel 'Applies part commands for current component

FilePath = Left(swComp.GetPathName, InStrRev(swComp.GetPathName, "\") - 1)

FileName = swChildModel.GetTitle 'Get title of component

swCurrent = swChildComp.ReferencedConfiguration 'Get current configuration of component

Bodies = swpart.GetBodies2(swBodyType_e.swAllBodies, True)

Set swBody = Bodies(0)

   If swBody.IsSheetMetal = 0 Then 'If Body is not sheet metal

       'Debug.Print "Component " & FileName & " is not a sheet metal component"

       'Debug.Print "Current Config is : "; swCurrent

           GoTo Jump

   End If

   If swBody.IsSheetMetal = 1 Then 'If body is sheet metal

       Debug.Print "Processing component " & FileName & " as a sheet metal component"

       Debug.Print "Current Config is : "; swCurrent

       GoTo Process

   End If

Process:

''''''''''''''''''''

Set swpart = swChildModel

sMatName = swpart.GetMaterialPropertyName2(swCurrent, sMatDB)

'Get part Thickness

Set swFeat = swChildModel.FirstFeature

   While Not swFeat Is Nothing

   If swFeat.GetTypeName = "SheetMetal" Then

       Set swsheetmetal = swFeat.GetDefinition

   End If

Set swFeat = swFeat.GetNextFeature

   Wend

Set swOpenModel = swApp.ActivateDoc3(swChildModel.GetPathName, True, loptions, lerrors)

Boolstatus = swChildModel.ShowConfiguration2(swCurrent)

'swChildModel.ExportFlatPatternView exFileName & ".DWG", 0

'''''''''''''update cutlist

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swFeat = swModel.FirstFeature

    If swFeat Is Nothing Then

    MsgBox "Failed to get first feature"

    End If

Do While Not swFeat Is Nothing

        If swFeat.GetTypeName2 = "SolidBodyFolder" Then

            Set swBodyFolder = swFeat.GetSpecificFeature2

            If swBodyFolder Is Nothing Then MsgBox "Failed to get body folder"

            swBodyFolder.SetAutomaticCutList (True)

            swBodyFolder.UpdateCutList

            Exit Do

        End If

        Set swFeat = swFeat.GetNextFeature

Loop

swApp.CloseDoc (swChildModel.GetPathName)

''''''''''''''''''''''

GoTo Jump

Skip:

   Debug.Print "Skipped"

Jump:

       TraverseComponent swChildComp, nLevel + 1

          Next i

End Sub

'''''''''''''''''''''''''