2 Replies Latest reply on Jan 16, 2018 10:53 AM by Matt Bieringer

    Get macro to save as part and combine solids

    Thijs Vernooij

      Hi guys,

       

      I've created a macro to save an assembly as a part, open that part, and combine all solids.

       

      It's running okay, but the point is that when i run the macro starting from an assembly, the macro creates the part, opens that created part, but then stops running.

      I have to click again on the same macro, and then it's creating the combine of all the solids.

       

      When I edit the macro, and run it step by step (F8), it will run continiously.

       

      I need to run the macro continiously from the assembly, so I can create STL files automatically.

       

      Thanks for your help,

       

      Thijs

      -------

           

      Option Explicit

       

       

      Sub SaveAndOpen(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2)

       

       

       

       

      Dim SwDoc As ModelDoc2

      'Dim swApp As Object

       

       

      Dim sldwrks As SldWorks.SldWorks

      Dim Part As ModelDoc2

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

      Dim swRootComp As SldWorks.Component2

      Dim sPadStr As String

      Dim vBody As Variant

       

       

      Set sldwrks = _

      Application.SldWorks

       

       

      Set Part = sldwrks.ActiveDoc

       

       

      Dim newfileName As String

      newfileName = Part.GetPathName

       

       

      newfileName = Replace(newfileName, ".sldasm", ".sldprt")

      newfileName = Replace(newfileName, ".SLDASM", ".SLDPRT")

       

       

      Debug.Print newfileName;

       

       

      longstatus = Part.SaveAs3(newfileName, 0, 0)

       

       

      Set swApp = _

      Application.SldWorks

      Set Part = swApp.ActiveDoc

      Set Part = swApp.OpenDoc6(newfileName, 1, 0, "", longstatus, longwarnings)

      'Set Part = swApp.OpenDoc6("L:\Moogue\DriveWorks\DW-Orders\WebShopBestelling\1187-2455-BHSHUVZVL__-Marjolein Smids_TextSleutelhanger-SLT001_ ID109\1187-2455_2325_-TextSleutelhanger-SLT001----L_Johnny_-R_UwspaceText_-Oranje-_ ID109.SLDPRT", 1, 0, "", longstatus, longwarnings)

       

       

       

       

      'Set Part = Nothing

      'Set sldwrks = Nothing

       

       

      SelectBodies swApp, swModel, vBody, sPadStr

       

       

      End Sub

       

       

      Sub SelectBodies(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, vBody As Variant, sPadStr As String)

       

       

          Dim swModExt As SldWorks.ModelDocExtension

          Dim swBody As SldWorks.Body2

          Dim sBodySelStr As String

          Dim sBodyTypeSelStr As String

          Dim i As Long

          Dim bRet As Boolean

          Dim swCombineBodiesFeatureData As SldWorks.CombineBodiesFeatureData

          Dim swFeature As SldWorks.Feature

          Dim status As Boolean

          Dim errors As Long

          Dim warnings As Long

          Dim newfileName As String

       

       

         

      Dim Part As Object

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

      'Dim myFeature As Object

      'Su main()

      Dim myFeature As Object

      Set swApp = _

      Application.SldWorks

       

       

      Set Part = swApp.ActiveDoc

      'Set Part = swApp.OpenDoc6(newfileName, 1, 0, "", longstatus, longwarnings)

         

       

       

       

          'If IsEmpty(vBody) Then Set myFeature = Part.FeatureManager.InsertCombineFeature(swBodyOperationType_e.SWBODYADD, Nothing, vBody)

          'If IsEmpty(vBody) Then Set myFeature = Part.FeatureManager.InsertCombineFeature(15903, Nothing, vBody)

          'If IsEmpty(vBody) Then Set myFeature = Part.FeatureManager.InsertDeleteBody2(True)

          

         

          If IsEmpty(vBody) Then Exit Sub

        

          Set swModExt = swModel.Extension

       

       

          For i = 0 To UBound(vBody)

              Set swBody = vBody(i)

              sBodySelStr = swBody.GetSelectionId

              Debug.Print "  " & sPadStr & sBodySelStr

       

       

              Select Case swBody.GetType

                  Case swSolidBody

                      sBodyTypeSelStr = "SOLIDBODY"

                  Case swSheetBody

                      sBodyTypeSelStr = "SURFACEBODY"

                  Case Else

                      Debug.Assert False

              End Select

             

            

              boolstatus = Part.Extension.SelectByID2(sBodySelStr, sBodyTypeSelStr, 0, 0, 0, True, 0, Nothing, 0)

            

              Set myFeature = Part.FeatureManager.InsertCombineFeature(15903, Nothing, vBody)

         

          Next i

       

       

      End Sub

       

       

      Sub ProcessComponent(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swComp As SldWorks.Component2, nLevel As Long)

       

       

          Dim vChildComp As Variant

          Dim swChildComp As SldWorks.Component2

          Dim sPadStr As String

          Dim vBody As Variant

          Dim i As Long

       

       

          For i = 0 To nLevel - 1

              sPadStr = sPadStr + "  "

          Next i

       

       

          Debug.Print sPadStr & swComp.Name2 & " <" & swComp.ReferencedConfiguration & ">"

       

       

          ' Solid bodies

          vBody = swComp.GetBodies2(swSolidBody)

          SelectBodies swApp, swModel, vBody, sPadStr

       

       

          ' Surface bodies

          vBody = swComp.GetBodies2(swSheetBody)

          SelectBodies swApp, swModel, vBody, sPadStr

       

       

          vChildComp = swComp.GetChildren

          For i = 0 To UBound(vChildComp)

              Set swChildComp = vChildComp(i)

              ProcessComponent swApp, swModel, swChildComp, nLevel + 1

          Next i

       

       

      End Sub

       

       

      Sub ProcessAssembly(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2)

       

       

          Dim swConfigMgr As SldWorks.ConfigurationManager

          Dim swConf As SldWorks.Configuration

          Dim swRootComp As SldWorks.Component2

       

       

          Set swConfigMgr = swModel.ConfigurationManager

          Set swConf = swConfigMgr.ActiveConfiguration

          Set swRootComp = swConf.GetRootComponent3(True)

          ProcessComponent swApp, swModel, swRootComp, 1

       

       

      End Sub

       

       

      Sub Combiner(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2)

       

       

      Dim Part As Object

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

      Dim myFeature As Object

      Dim sldwrks As SldWorks.SldWorks

       

       

      'Dim Part As ModelDoc2

      'Dim boolstatus As Boolean

      'Dim longstatus As Long, longwarnings As Long

      'Dim swApp As SldWorks.SldWorks

      'Dim swModel As SldWorks.ModelDoc2

       

       

      Dim swModelDocExt As SldWorks.ModelDocExtension

      Dim swFeatureMgr As SldWorks.FeatureManager

      Dim swFeature As SldWorks.Feature

      Dim swCombineBodiesFeatureData As SldWorks.CombineBodiesFeatureData

      Dim fileName As String

      Dim status As Boolean

      Dim errors As Long

      Dim warnings As Long

       

       

      'Dim swApp As Object

      'Dim Part As Object

      'Dim boolstatus As Boolean

      'Dim longstatus As Long, longwarnings As Long

         

      'Dim myFeature As Object

       

       

          'Set swApp = Application.SldWorks

      '    Set Part = sldwrks.ActiveDoc

       

       

          'fileName = "C:\Program Files\SolidWorks Corp\SolidWorks\samples\tutorial\multibody\multi_inter.sldprt"

          'Set swModel = swApp.OpenDoc6(fileName, swDocumentTypes_e.swDocPART, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)

          'Set swModel = SldWorks.ActiveDoc

       

       

          'Set swModelDocExt = swModel.Extension

          'status = swModelDocExt.SelectByID2("Extrude-Thin1", "SOLIDBODY", 0, 0, 0, True, 0, Nothing, 0)

          'status = swModelDocExt.SelectByID2("Boss-Extrude1", "SOLIDBODY", 0, 0, 0, True, 0, Nothing, 0)

          'swModel.ClearSelection2 False

          'status = swModelDocExt.SelectByID2("Extrude-Thin1", "SOLIDBODY", 0, 0, 0, False, 2, Nothing, 0)

          'status = swModelDocExt.SelectByID2("Boss-Extrude1", "SOLIDBODY", 0, 0, 0, True, 2, Nothing, 0)

          'Set swFeatureMgr = swModel.FeatureManager

          'Set swFeature = swFeatureMgr.InsertCombineFeature(swBodyOperationType_e.SWBODYADD, Nothing, Nothing)

       

       

          'Set swCombineBodiesFeatureData = swFeature.GetDefinition

          'status = swCombineBodiesFeatureData.AccessSelections(swModel, Nothing)

          'swCombineBodiesOperationType_e:

          ' swCombineBodiesOperationAdd = 0

          ' swCombineBodiesOperationCommon = 2

          ' swCombineBodiesOperationSubract = 1

          'Debug.Print "Type of combine feature: " & swCombineBodiesFeatureData.OperationType

          'swCombineBodiesFeatureData.ReleaseSelectionAccess

       

       

      'Set myFeature = Part.FeatureManager.InsertCombineFeature(15903, Nothing, Nothing)

         

      'Set myFeature = Part.FeatureManager.InsertDeleteBody2(True)

       

       

      End Sub

       

       

      Sub main()

       

       

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

          Dim swPart As SldWorks.PartDoc

          Dim vBody As Variant

          Dim i As Long

          Dim bRet As Boolean

       

       

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

       

       

          swModel.ClearSelection2 True

       

       

          Debug.Print "File = " & swModel.GetPathName

       

       

          Select Case swModel.GetType

              Case swDocPART

                  Set swPart = swModel

                  ' Solid bodies

                  vBody = swPart.GetBodies2(swSolidBody, True)

                  SelectBodies swApp, swModel, vBody, ""

                  Combiner swApp, swModel

                  ' Surface bodies

                  vBody = swPart.GetBodies2(swSheetBody, True)

                  SelectBodies swApp, swModel, vBody, ""

              Case swDocASSEMBLY

                  'ProcessAssembly swApp, swModel

                  SaveAndOpen swApp, swModel

              Case Else

                  Exit Sub

       

       

          End Select

       

       

      End Sub

       

      -----

        • Re: Get macro to save as part and combine solids
          Matt Bieringer

          You have a case selection in Sub main(). Because you are using a case selection there is no way for the macro to know when the partdoc is open. So the easiest way to do this is to copy what you have in the part case into the assembly case. I set up a loop that checks what part doc is open and the does until it equals swDocPART.

           

           

          Sub main()
              Dim swApp As SldWorks.SldWorks
              Dim swModel As SldWorks.ModelDoc2
              Dim swPart As SldWorks.PartDoc
              Dim vBody As Variant
              Dim i As Long
              Dim bRet As Boolean
              Set swApp = Application.SldWorks
              Set swModel = swApp.ActiveDoc
              swModel.ClearSelection2 True
              Debug.Print "File = " & swModel.GetPathName
              Do Until swModel.GetType = swDocPART
              Set swModel = swApp.ActiveDoc
                  Select Case swModel.GetType
                      Case swDocPART
                          Set swPart = swModel
                          ' Solid bodies
                          vBody = swPart.GetBodies2(swSolidBody, True)
                          SelectBodies swApp, swModel, vBody, ""
                          Combiner swApp, swModel
                          ' Surface bodies
                          vBody = swPart.GetBodies2(swSheetBody, True)
                          SelectBodies swApp, swModel, vBody, ""
                      Case swDocASSEMBLY
                          'ProcessAssembly swApp, swModel
                          SaveAndOpen swApp, swModel
                      Case Else
                          Exit Sub
              
                  End Select
              Loop
          End Sub
          
          • Re: Get macro to save as part and combine solids
            Matt Bieringer

            Also the reason it would work in Step Into (F8) is more than likely you pressed F8 after completion and it restarted the macro.