2 Replies Latest reply on Oct 27, 2015 5:45 AM by Hrituc Alexandru

    Update CUT LIST to all assembly components

    Hrituc Alexandru

      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

       

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