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
-----
SolidworksApi macros