Get Body Outline Example (VBA)
This example shows how to get the outline of a solid body.
This example also creates and inserts a sketch of that outline.
'---------------------------------------------------------------------------------------
' Preconditions: Open a part document that contains at least one solid body.
'
' Postconditions: The body outline curves are processed to remove gaps
'
before they are sketched.
'--------------------------------------------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.PartDoc
Dim swModel As SldWorks.ModelDoc2
Dim swMathVector As SldWorks.MathVector
Dim swMathUtility As SldWorks.MathUtility
Dim swModeler As SldWorks.Modeler
Dim dirVar As Variant
Dim bVar As Variant
Dim crvOut As Variant
Dim topol As Variant
Dim outline As Variant
Dim sEva As Variant
Dim eEva As Variant
Dim sEvaPrev As Variant
Dim eEvaPrev As Variant
Dim sEvaNext As Variant
Dim eEvaNext As Variant
Dim dirArr(0 To 2) As Double
Dim s As Double
Dim e As Double
Dim nCt As Long
Dim i As Long
Dim v As Long
Dim isClosed As Boolean
Dim isPer As Boolean
Enum direction
X = 1
Y = 2
Z = 3
Xminus = 4
Yminus = 5
Zminus = 6
End Enum
Sub main()
Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Set swModel = swPart
'Get the bodies in this part
bVar = swPart.GetBodies2(swSolidBody, False)
Set swModeler = swApp.GetModeler
Set swMathUtility = swApp.GetMathUtility
'Create the direction vector
dirArr(0) = 0
dirArr(1) = 0
dirArr(2) = 0
Dim userDirection As direction
userDirection = Y
If userDirection = X Then
dirArr(0) = 1
ElseIf userDirection = Xminus Then
dirArr(0) = -1
ElseIf userDirection = Y Then
dirArr(1) = 1
ElseIf userDirection = Yminus Then
dirArr(1) = -1
ElseIf userDirection = Z Then
dirArr(2) = 1
ElseIf userDirection = Zminus Then
dirArr(2) = -1
End If
dirVar = dirArr
'Create a MathVector
Set swMathVector = swMathUtility.CreateVector((dirArr))
'Get the number of curves in the body
outline
nCt = swModeler.GetBodyOutline2((bVar), swMathVector,
0.00001, True, crvOut, topol, outline)
'Open a 3D sketch in the part document
swPart.Insert3DSketch
'Using the end conditions of the curves,
create a 2D sketch of each curve
Dim vCurve() As Curve
Dim newCt As Integer
For i = 0 To nCt - 1
crvOut(i).GetEndParams s, e,
isClosed, isPer
If crvOut(i).GetLength3(s, e)
> 0.00001 Then
ReDim
Preserve vCurve(newCt)
Set
vCurve(newCt) = crvOut(i)
newCt = newCt + 1
End If
Next
Dim sPoints() As Double
Dim ePoints() As Double
ReDim sPoints((newCt * 3) - 1)
ReDim ePoints((newCt * 3) - 1)
For i = 0 To newCt - 1
vCurve(i).GetEndParams s, e,
isClosed, isPer
sEva = vCurve(i).Evaluate(s)
eEva = vCurve(i).Evaluate(e)
If i > 0 Then
v = i - 1
Else
v = newCt - 1
End If
vCurve(v).GetEndParams
s, e, isClosed, isPer
sEvaPrev = vCurve(v).Evaluate(s)
eEvaPrev = vCurve(v).Evaluate(e)
If i < newCt - 1
Then
v = i + 1
Else
v = 0
End If
vCurve(v).GetEndParams
s, e, isClosed, isPer
sEvaNext = vCurve(v).Evaluate(s)
eEvaNext = vCurve(v).Evaluate(e)
sPoints(i * 3) =
sEva(0) + 0.5 * (eEvaPrev(0) - sEva(0))
sPoints(i * 3 + 1) = sEva(1) + 0.5 *
(eEvaPrev(1) - sEva(1))
sPoints(i * 3 + 2) = sEva(2) + 0.5 *
(eEvaPrev(2) - sEva(2))
ePoints(i * 3) =
eEva(0) + 0.5 * (sEvaNext(0) - eEva(0))
ePoints(i * 3 + 1) = eEva(1) + 0.5 *
(sEvaNext(1) - eEva(1))
ePoints(i * 3 + 2) = eEva(2) + 0.5 *
(sEvaNext(2) - eEva(2))
If userDirection =
X Or userDirection = Xminus Then
sPoints(i *
3) = 0
ePoints(i *
3) = 0
ElseIf userDirection = Y Or
userDirection = Yminus Then
sPoints(i * 3
+ 1) = 0
ePoints(i * 3
+ 1) = 0
ElseIf userDirection = Z Or
userDirection = Zminus Then
sPoints(i * 3
+ 2) = 0
ePoints(i * 3
+ 2) = 0
End If
Next i
For i = 0 To (newCt * 3) - 1 Step 3
swModel.CreateLine2 sPoints(i),
sPoints(i + 1), sPoints(i + 2), ePoints(i), ePoints(i + 1), ePoints(i + 2)
Next
'Insert the sketches
swModel.InsertSketch2 True
swModel.ClearSelection2 True
End Sub