Get Sketch Contours (VBA)
This example shows how to get the sketch contours in a model document.
'------------------------------------------------
' Preconditions: Model document open and contains a Sketch1
feature.
'
' Postconditions: None
'-------------------------------------------------
Option Explicit
Sub main()
Dim
swApp As SldWorks.SldWorks
Dim
myModel As SldWorks.ModelDoc2
Dim
myPart As SldWorks.PartDoc
Dim
SelMgr As SldWorks.SelectionMgr
Dim
mySelectData as SldWorks.SelectData
Dim
myFeature As SldWorks.Feature
Dim
mySketch As SldWorks.Sketch
Dim
contourCount As Integer
Dim
vSkContours As Variant
Dim
skContour As SketchContour
Dim
myLoop As Loop2
Dim
edgeCount As Long, vertexCount As Long
Dim
vEdges As Variant, myEdge As SldWorks.Edge
Dim
vVertices As Variant, myVertex As SldWorks.Vertex
Dim
vPoint As Variant, X As Double, Y As Double, Z As Double
Dim
outer As Boolean, strOuter As String
Dim
skSegCount As Long
Dim
vSkSegments As Variant
Dim
skSegment As SldWorks.SketchSegment
Dim
skSegType As Long, skSegTypesString As String
Dim
closed As Boolean, closedString As String
Dim
i As Integer, j As Integer, k As Integer
Dim
boolstatus As Boolean
Dim
longstatus As Long, longwarnings As Long
Set
swApp = Application.SldWorks
Set
myModel = swApp.ActiveDoc
Set
SelMgr = myModel.SelectionManager
Set
mySelectData = SelMgr.CreateSelectData
Set
myPart = myModel
Set
myFeature = myPart.FeatureByName("Sketch1")
Set
mySketch = myFeature.GetSpecificFeature2()
' or
' Set
mySketch = myModel.GetActiveSketch2()
' Set
myFeature = mySketch
If
Not mySketch Is Nothing Then
vSkContours
= mySketch.GetSketchContours()
contourCount
= UBound(vSkContours) - LBound(vSkContours) + 1
Debug.Print
""
Debug.Print
contourCount & " contours in sketch " & myFeature.Name
For
i = LBound(vSkContours) To UBound(vSkContours)
Set
skContour = vSkContours(i)
If
Not skContour Is Nothing Then
closed
= skContour.IsClosed()
If
(closed = 0) Then
closedString
= "open"
Else
closedString
= "closed"
End
If
Debug.Print
" contour
" & i & ": " & closedString
vSkSegments
= skContour.GetSketchSegments()
skSegCount
= UBound(vSkSegments) - LBound(vSkSegments) + 1
For
j = LBound(vSkSegments) To UBound(vSkSegments)
If
j = LBound(vSkSegments) Then
skSegTypesString
= "("
End
If
Set
skSegment = vSkSegments(j)
If
Not skSegment Is Nothing Then
skSegType
= skSegment.GetType()
Select
Case skSegType
Case
SwConst.swSketchSegments_e.swSketchLINE
skSegTypesString
= skSegTypesString & "line"
Case
SwConst.swSketchSegments_e.swSketchARC
skSegTypesString
= skSegTypesString & "arc"
Case
SwConst.swSketchSegments_e.swSketchELLIPSE
skSegTypesString
= skSegTypesString & "ellipse"
Case
SwConst.swSketchSegments_e.swSketchPARABOLA
skSegTypesString
= skSegTypesString & "parabola"
Case
SwConst.swSketchSegments_e.swSketchSPLINE
skSegTypesString
= skSegTypesString & "spline"
Case
SwConst.swSketchSegments_e.swSketchTEXT
skSegTypesString
= skSegTypesString & "text"
Case
Default
skSegTypesString
= skSegTypesString & "unknown"
End
Select
End
If
If
j = UBound(vSkSegments) Then
skSegTypesString
= skSegTypesString & ")"
Else
skSegTypesString
= skSegTypesString & ","
End
If
Next
j
Debug.Print
" sketch
segment count = " & skSegCount & " " & skSegTypesString
vEdges
= skContour.GetEdges()
If
IsEmpty(vEdges) Then
Debug.Print
" No
edges."
Else
For
k = LBound(vEdges) To UBound(vEdges)
Set
myEdge = vEdges(k)
If
Not myEdge Is Nothing Then
Debug.Print
" Edge
" & k & ": "
End
If
Next
k
End
If
boolstatus
= skContour.Select2(False, mySelectData)
If
boolstatus = 0 Then
Debug.Print
" Selection
of contour failed."
End
If
Stop
End
If
Next
i
End
If
End Sub