Find Outside Edges of Face Example (VBA)
This example shows how to find the outside edges of the selected face.
'-----------------------------------------
'
' Preconditions: Part is open and a face is selected.
'
' Postconditions: None
'
'------------------------------------------
Option Explicit
Sub CreateTessCurve _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
swSketch
As SldWorks.sketch, _
swTrimCurve
As SldWorks.curve _
)
Const
nChordTol As
Double = 0.001 '
Meters
Const
nLengthTol As
Double = 0.001 '
Meters
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
'
Really not needed because curve is a trimmed curve,
'
so 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))
'
Disable VB range checking because tessellation points
'
may not be a multiple of 6
On
Error Resume Next
For
i = 0 To UBound(vTessPts) Step 3
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
End Sub
Sub CreateTessLoop _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
swLoop
As SldWorks.Loop2 _
)
Dim
vEdgeArr As
Variant
Dim
vEdge As
Variant
Dim
swEdge As
SldWorks.Edge
Dim
swCurve As
SldWorks.curve
Dim
swSketch As
SldWorks.sketch
Dim
bRet As
Boolean
swModel.Insert3DSketch2 False
swModel.SetAddToDB True
swModel.SetDisplayWhenAdded False
Set
swSketch = swModel.GetActiveSketch2
vEdgeArr
= swLoop.GetEdges: Debug.Assert
UBound(vEdgeArr) >= 0
For
Each vEdge In vEdgeArr
Set
swEdge = vEdge
Set
swCurve = swEdge.GetCurve
CreateTessCurve
swApp, swModel, swSketch, swCurve
Next
vEdge
swModel.SetDisplayWhenAdded True
swModel.SetAddToDB False
swModel.Insert3DSketch2 True
bRet
= swModel.EditRebuild3: Debug.Assert
bRet
End Sub
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swPart As
SldWorks.PartDoc
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swFace As
SldWorks.face2
Dim
swLoop As
SldWorks.Loop2
Dim
i As
Long
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swPart = swModel
Set
swSelMgr = swModel.SelectionManager
Set
swFace = swSelMgr.GetSelectedObject5(1)
Debug.Print
"FaceArea =
" & swFace.GetArea *
1000000# & " mm^2"
Debug.Print
" LoopCount
=
" & swFace.GetLoopCount
Debug.Print
""
Set
swLoop = swFace.GetFirstLoop
Do
While Not swLoop Is Nothing
i
= i + 1
Debug.Print
" Loop("
& i & ")"
Debug.Print
" IsOuter
=
" & swLoop.IsOuter
Debug.Print
" IsSingular
= " & swLoop.IsSingular
If
swLoop.IsOuter Then
CreateTessLoop
swApp, swModel, swLoop
End
If
Set
swLoop = swLoop.GetNext
Loop
End Sub
'-----------------------------------------