Create Solid Bodies using Geometry and Topology APIs Example (VBA)
This example shows how to create a solid body using these geometry and
topology APIs:
IBody2::Check3
IBody2::Operations2
IModeler::CreateBodyFromBox
IModeler::CreateBodyFromCone
IPartDoc::CreateFeatureFromBody3
'--------------------------------------------------
'
' Problem:
' This
example shows how to use some of
' the
geometry and topolgy APIs to
' construct
temporary API bodies, perform
' a
boolean addition, and then create a solid
' body
feature from the result.
'
' Preconditions: None
'
' Postconditions: A new part is created containing a single
solid
' body
feature that is the union of a box and
' a
cone.
'
'---------------------------------------------------
Option Explicit
Const SWBODYINTERSECT As
Integer = 15901
Const SWBODYCUT As
Integer = 15902
Const SWBODYADD As
Integer = 15903
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 Enum swCreateFeatureBodyOpts_e
swCreateFeatureBodyCheck
= &H1
swCreateFeatureBodySimplify
= &H2
End Enum
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swModeler As
SldWorks.Modeler
Dim
swFeat As
SldWorks.feature
Dim
nConeParam(8) As
Double
Dim
vConeArr As
Variant
Dim
swConeBody As
SldWorks.body2
Dim
nBoxParam(8) As
Double
Dim
vBoxArr As
Variant
Dim
swBoxBody As
SldWorks.body2
Dim
vNewBodyArr As
Variant
Dim
vNewBody As
Variant
Dim
swNewPart As
SldWorks.PartDoc
Dim
swNewBody As
SldWorks.body2
Dim
swFaultEnt As
SldWorks.FaultEntity
Dim
nRetVal As
Long
Dim
bRet As
Boolean
Dim
nCount As
Long
'
Form cone
'
Face center
nConeParam(0)
= 0#
nConeParam(1)
= 0.1
nConeParam(2)
= 0#
'
Axis
nConeParam(3)
= 0#
nConeParam(4)
= 0#
nConeParam(5)
= 1#
'
Base radius
nConeParam(6)
= 0.2
'
Top radius
nConeParam(7)
= 0.1
'
Height
nConeParam(8)
= 0.3
vConeArr
= nConeParam
'
Form box
'
Face center
nBoxParam(0)
= 0#
nBoxParam(1)
= 0.1
nBoxParam(2)
= 0.2
'
Axis
nBoxParam(3)
= 0#
nBoxParam(4)
= 0#
nBoxParam(5)
= 1#
'
Width
nBoxParam(6)
= 0.3
'
Length
nBoxParam(7)
= 0.25
'Height
nBoxParam(8)
= 0.4
vBoxArr
= nBoxParam
Set
swApp = CreateObject("SldWorks.Application")
Set
swModeler = swApp.GetModeler
Set
swConeBody = swModeler.CreateBodyFromCone((vConeArr))
Set
swBoxBody = swModeler.CreateBodyFromBox((vBoxArr))
'
Must be valid because parameters were specified
Debug.Assert
Not swConeBody Is Nothing
Set
swFaultEnt = swConeBody.Check3
nCount
= swFaultEnt.Count
If
nCount <> 0 Then
Debug.Print
"Faulty cone!"
Exit
Sub
End
If
'
Must be valid because parameters were specified
Debug.Assert
Not swBoxBody Is Nothing
Set
swFaultEnt = swBoxBody.Check3
nCount
= swFaultEnt.Count
If
nCount <> 0 Then
Debug.Print
"Faulty box!"
Exit
Sub
End
If
'
Must work because both bodies were created
vNewBodyArr
= swConeBody.Operations2(SWBODYADD,
swBoxBody, nRetVal)
Debug.Assert
swBodyOperationNoError = nRetVal
Set
swNewPart = swApp.NewPart
For
Each vNewBody In vNewBodyArr
Set
swNewBody = vNewBody
'
Force creation of a solid body feature
Set
swFeat = swNewPart.CreateFeatureFromBody3(swNewBody,
False, _
swCreateFeatureBodyCheck
+ swCreateFeatureBodySimplify)
'
Must be able to create a solid body feature from a solid body
Debug.Assert
Not swFeat Is Nothing
Next
End Sub
'--------------------------------------------------