Combine Assembly Components into Part Example (VBA)
This example shows how to combine two assembly components into a part.
'------------------------------------------
'
' Preconditions:
' (1)
Assembly is open.
' (2)
Two components are selected.
' (3)
Both components are single body components.
' (4)
Both components only contain solid bodies.
'
' Postconditions:
' (1)
New part is created.
' (2)
New part is boolean addition of both selected components.
'
' Notes: This example does not replace
' saving
an assembly as a part. This example only
' illustrates
the use of several geometric and topological APIs.
'
'---------------------------------------------
Option Explicit
Public Enum swBodyType_e
swSolidBody
= 0
swSheetBody
= 1
swWireBody
= 2
swMinimumBody
= 3
swGeneralBody
= 4
swEmptyBody
= 5
End Enum
Public Enum swCreateFeatureBodyOpts_e
swCreateFeatureBodyCheck
= &H1
swCreateFeatureBodySimplify
= &H2
End Enum
Public Enum swBodyOperationError_e
swBodyOperationUnknownError
= -1
swBodyOperationNoError
= 0
swBodyOperationNonApiBody
= 1
swBodyOperationWrongType
= 2
swBodyOperationBooleanFail
= 1058
swBodyOperationNoIntersect
= 1067
swBodyOperationNonManifold
= 547
swBodyOperationPartialCoincidence
= 1040
swBodyOperationIntersectSolidWithSheets
= 972
swBodyOperationUniteSolidSheet
= 543
swBodyOperationMissingGeom
= 96
swBodyOperationSameToolAndTarget
= 545
swBodyOperationFailGeomCondition
= 3
swBodyOperationFailToCutBody
= 4
swBodyOperationDisjointBodies
= 5
swBodyOperationEmptyBody
= 6
swBodyOperationEmptyInputBody
= 7
End Enum
Public Const SWBODYINTERSECT As
Integer = 15901
Public Const SWBODYCUT As
Integer = 15902
Public Const SWBODYADD As
Integer = 15903
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swComp1 As
SldWorks.Component2
Dim
swComp2 As
SldWorks.Component2
Dim
swXform1 As
SldWorks.MathTransform
Dim
swXform2 As
SldWorks.MathTransform
Dim
swBody1 As
SldWorks.body2
Dim
swBody1Copy As
SldWorks.body2
Dim
swBody2 As
SldWorks.body2
Dim
swBody2Copy As
SldWorks.body2
Dim
vBodyResArr As
Variant
Dim
vBodyRes As
Variant
Dim
swBodyRes As
SldWorks.body2
Dim
swPartRes As
SldWorks.PartDoc
Dim
swFeatRes As
SldWorks.feature
Dim
nRetval As
Long
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
Set
swComp1 = swSelMgr.GetSelectedObjectsComponent2(1)
Set
swComp2 = swSelMgr.GetSelectedObjectsComponent2(2)
Set
swXform1 = swComp1.Transform2
Set
swXform2 = swComp2.Transform2
Set
swBody1 = swComp1.GetBody: Debug.Assert
Not swBody1 Is Nothing: Debug.Assert swSolidBody = swBody1.GetType
Set
swBody2 = swComp2.GetBody: Debug.Assert
Not swBody2 Is Nothing: Debug.Assert swSolidBody = swBody2.GetType
Set
swBody1Copy = swBody1.Copy
Set
swBody2Copy = swBody2.Copy
bRet
= swBody1Copy.ApplyTransform(swXform1):
Debug.Assert bRet
bRet
= swBody2Copy.ApplyTransform(swXform2):
Debug.Assert bRet
vBodyResArr
= swBody1Copy.Operations2(SWBODYADD,
swBody2Copy, nRetval): Debug.Assert swBodyOperationNoError = nRetval
Debug.Assert
Not IsEmpty(vBodyResArr)
Set
swPartRes = swApp.NewDocument("C:\Program
Files\SolidWorks\data\templates\part.prtdot", 0, 0, 0)
For
Each vBodyRes In vBodyResArr
Set
swBodyRes = vBodyRes
Set
swFeatRes = swPartRes.CreateFeatureFromBody3(swBodyRes,
False, _
swCreateFeatureBodyCheck
+ swCreateFeatureBodySimplify): Debug.Assert Not swFeatRes Is Nothing
Next
End Sub
'------------------------------------------