Create Save Bodies Feature and Create an Assembly (VBA)
This example shows how to create:
'-----------------------------------------------
' Preconditions: Part document is open and contains
' a
solid body that has been split.
'
' Postconditions: C:\temp\asd1.sldprt, C:\temp\asd2.sldprt,
' and
C:\temp\asdf.sldasm are created. In the
' original
part, the Split solid bodies in the
' Solid
Bodies folder are now Save Bodies
' solid
bodies.
'-----------------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeat As SldWorks.Feature
Dim swFeatMgr As SldWorks.FeatureManager
Dim swBodyFolder As SldWorks.BodyFolder
Dim v1 As Variant
Dim i As Long
Dim fileNames(1) As String
Dim fileNameVar As Variant
Sub GetVariantOfBody(swFeature As SldWorks.Feature, bodyList
As Variant)
Dim
tt As Variant
Set
swBodyFolder = swFeature.GetSpecificFeature2
Dim
count As Integer
count
= swBodyFolder.GetBodyCount
If
(count < 1) Then
MsgBox
("There are no bodies. Please create a body.")
Else
bodyList
= swBodyFolder.GetBodies
End
If
End Sub
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swFeat = swModel.FirstFeature
Set swFeatMgr = swModel.FeatureManager
Dim contLoop As Boolean
contLoop = True
While Not swFeat Is Nothing And contLoop = True
Dim
Name As String
Name
= swFeat.GetTypeName2
If
(Name = "SolidBodyFolder") Then
GetVariantOfBody
swFeat, v1
contLoop
= False
End
If
If
(contLoop = True) Then
Set
swFeat = swFeat.GetNextFeature
End
If
Wend
fileNames(0) = "C:\temp\asd1.sldprt"
fileNames(1) = "C:\temp\asd2.sldprt"
fileNameVar = fileNames
swFeatMgr.CreateSaveBodyFeature
v1, fileNameVar, "C:\temp\asdf.sldasm", True, True
End Sub