Get Intersecting Faces Example (VBA)
This example shows how to get the intersection of two faces.
'-----------------------------------------------
'
' Problem:
' Two
faces intersect in a series of curves.
'
' This
code shows how to use some of the geometry-related and
' topology-related
APIs to get the intersecting surfaces.
' Specifically,
it shows the use of:
'
' ISurface::IntersectSurface
'
' Preconditions:
' (1)
Part of assembly is open.
' (2)
Assembly is fully resolved.
' (3)
Two items are selected in the graphics window.
' (4)
Face is the first selected item.
' (5)
Face is the second selected item.
' (6)
Two faces intersect.
'
' Postconditions: For each intersection curve, a 3D sketch
is inserted with
' a
series of line segments approximating the intersection
' curve.
'
'-----------------------------------------------
Option Explicit
Sub CreateTessCurve _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
swTrimCurve
As SldWorks.Curve _
)
Const
nChordTol As
Double = 0.001
Const
nLengthTol As
Double = 0.001
Dim
nStartParam As
Double
Dim
nEndParam As
Double
Dim
bIsClosed As
Boolean
Dim
bIsPeriodic As
Boolean
Dim
vStartPt As
Variant
Dim
vEndPt As
Variant
Dim
vTessPts As
Variant
Dim
swSketchSeg As
SldWorks.SketchSegment
Dim
bRet As
Boolean
Dim
i As
Long
'
Not needed because curve is a trimmed curve
'
Could pass in trim points as parameters
bRet
= swTrimCurve.GetEndParams(nStartParam,
nEndParam, bIsClosed, bIsPeriodic)
Debug.Assert
bRet
vStartPt
= swTrimCurve.Evaluate(nStartParam)
vEndPt
= swTrimCurve.Evaluate(nEndParam)
vTessPts
= swTrimCurve.GetTessPts(nChordTol,
nLengthTol, (vStartPt), (vEndPt))
swModel.SetAddToDB True
swModel.Insert3DSketch2 False
'
Disable Visual Basic range checking because tessellation points
'
may not be a multiple of 6
On
Error Resume Next
For
i = 0 To UBound(vTessPts) Step 6
Set
swSketchSeg = swModel.CreateLine2(
_
vTessPts(i
+ 0), vTessPts(i + 1), vTessPts(i + 2), _
vTessPts(i
+ 3), vTessPts(i + 4), vTessPts(i + 5))
Next
i
On
Error GoTo 0
swModel.SetAddToDB False
swModel.Insert3DSketch2 True
bRet
= swModel.EditRebuild3
Debug.Assert
bRet
End Sub
Function CreateTrimmedCurve _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
swSurf
As SldWorks.surface, _
swCurve
As SldWorks.Curve _
) As SldWorks.Curve
Dim
nStartParam As
Double
Dim
nEndParam As
Double
Dim
bIsClosed As
Boolean
Dim
bIsPeriodic As
Boolean
Dim
vStartPt As
Variant
Dim
vEndPt As
Variant
Dim
nCurveBounds(0 To 5) As
Double
Dim
vCurveBounds As
Variant
Dim
vPointArray As
Variant
Dim
vTArray As
Variant
Dim
vUVArray As
Variant
Dim
bRet As
Boolean
bRet
= swCurve.GetEndParams(nStartParam,
nEndParam, bIsClosed, bIsPeriodic)
Debug.Assert
bRet
vStartPt
= swCurve.Evaluate(nStartParam)
vEndPt
= swCurve.Evaluate(nEndParam)
nCurveBounds(0)
= vStartPt(0)
nCurveBounds(1)
= vStartPt(1)
nCurveBounds(2)
= vStartPt(2)
nCurveBounds(3)
= vEndPt(0)
nCurveBounds(4)
= vEndPt(1)
nCurveBounds(5)
= vEndPt(2)
vCurveBounds
= nCurveBounds
bRet
= swSurf.IntersectCurve(swCurve,
(vCurveBounds), vPointArray, vTArray, vUVArray)
Debug.Assert
bRet
Set
CreateTrimmedCurve = swCurve.CreateTrimmedCurve(
_
vPointArray(0),
vPointArray(1), vPointArray(2), _
vPointArray(3),
vPointArray(4), vPointArray(5))
End Function
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swFace1 As
SldWorks.face2
Dim
swFace2 As
SldWorks.face2
Dim
swSurf1 As
SldWorks.surface
Dim
swSurf2 As
SldWorks.surface
Dim
swCurve1 As
SldWorks.Curve
Dim
swCurve2 As
SldWorks.Curve
Dim
vCurveArray As
Variant
Dim
vBoundArray As
Variant
Dim
swIntCurve As
SldWorks.Curve
Dim
swTrimCurve As
SldWorks.Curve
Dim
nLength As
Double
Dim
i As
Long
Dim
bRet As
Boolean
Set
swApp = CreateObject("SldWorks.Application")
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
Set
swFace1 = swSelMgr.GetSelectedObject5(1)
Set
swFace2 = swSelMgr.GetSelectedObject5(2)
Set
swSurf1 = swFace1.GetSurface
Set
swSurf2 = swFace2.GetSurface
bRet
= swSurf1.IntersectSurface(swSurf2,
vCurveArray, vBoundArray)
Debug.Assert
bRet
For
i = 0 To UBound(vCurveArray)
Set
swIntCurve = vCurveArray(i)
'
Beware - curve could be infinite (that is, a straight line)!
If
swIntCurve.IsTrimmedCurve Then
nLength
= swIntCurve.GetLength2(vBoundArray(2
* i), vBoundArray(2 * i + 1))
Debug.Print
"Curve(" & i & ") = " & nLength * 1000#
& " mm"
Set
swTrimCurve = swIntCurve
Else
'
Create a trimmed curve by re-intersecting intersection curve with surface
Set
swTrimCurve = CreateTrimmedCurve(swApp, swModel, swSurf1, swIntCurve)
End
If
CreateTessCurve
swApp, swModel, swTrimCurve
Next
i
End Sub
'------------------------------------------------