Get Sketch Relations Example (VBA)
This example shows how to get all of the sketch relations in a sketch.
'------------------------------------------------------------------
'
' Preconditions:
' (1)
Part or assembly document is open.
' (2)
Sketch whose relations you want to get is selected.
'
' Postconditions: None
'
'--------------------------------------------------------------------
Option Explicit
Public Enum swSketchRelationFilterType_e
swAll
= 0
swDangling
= 1
swOverDefining
= 2
swExternal
= 3
swDefinedInContext
= 4
swLocked
= 5
swBroken
= 6
swSelectedEntities
= 7
End Enum
Public Enum swConstraintType_e
swConstraintType_INVALIDCTYPE
= 0
swConstraintType_DISTANCE
= 1
swConstraintType_ANGLE
= 2
swConstraintType_RADIUS
= 3
swConstraintType_HORIZONTAL
= 4
swConstraintType_VERTICAL
= 5
swConstraintType_TANGENT
= 6
swConstraintType_PARALLEL
= 7
swConstraintType_PERPENDICULAR
= 8
swConstraintType_COINCIDENT
= 9
swConstraintType_CONCENTRIC
= 10
swConstraintType_SYMMETRIC
= 11
swConstraintType_ATMIDDLE
= 12
swConstraintType_ATINTERSECT
= 13
swConstraintType_SAMELENGTH
= 14
swConstraintType_DIAMETER
= 15
swConstraintType_OFFSETEDGE
= 16
swConstraintType_FIXED
= 17
swConstraintType_ARCANG90
= 18
swConstraintType_ARCANG180
= 19
swConstraintType_ARCANG270
= 20
swConstraintType_ARCANGTOP
= 21
swConstraintType_ARCANGBOTTOM
= 22
swConstraintType_ARCANGLEFT
= 23
swConstraintType_ARCANGRIGHT
= 24
swConstraintType_HORIZPOINTS
= 25
swConstraintType_VERTPOINTS
= 26
swConstraintType_COLINEAR
= 27
swConstraintType_CORADIAL
= 28
swConstraintType_SNAPGRID
= 29
swConstraintType_SNAPLENGTH
= 30
swConstraintType_SNAPANGLE
= 31
swConstraintType_USEEDGE
= 32
swConstraintType_ELLIPSEANG90
= 33
swConstraintType_ELLIPSEANG180
= 34
swConstraintType_ELLIPSEANG270
= 35
swConstraintType_ELLIPSEANGTOP
= 36
swConstraintType_ELLIPSEANGBOTTOM
= 37
swConstraintType_ELLIPSEANGLEFT
= 38
swConstraintType_ELLIPSEANGRIGHT
= 39
swConstraintType_ATPIERCE
= 40
swConstraintType_DOUBLEDISTANCE
= 41
swConstraintType_MERGEPOINTS
= 42
swConstraintType_ANGLE3P
= 43
swConstraintType_ARCLENGTH
= 44
swConstraintType_NORMAL
= 45
swConstraintType_NORMALPOINTS
= 46
swConstraintType_SKETCHOFFSET
= 47
swConstraintType_ALONGX
= 48
swConstraintType_ALONGY
= 49
swConstraintType_ALONGZ
= 50
swConstraintType_ALONGXPOINTS
= 51
swConstraintType_ALONGYPOINTS
= 52
swConstraintType_ALONGZPOINTS
= 53
swConstraintType_PARALLELYZ
= 54
swConstraintType_PARALLELZX
= 55
swConstraintType_INTERSECTION
= 56
swConstraintType_PATTERNED
= 57
swConstraintType_ISOBYPOINT
= 58
swConstraintType_SAMEISOPARAM
= 59
swConstraintType_FITSPLINE
= 60
End Enum
Public Enum swSketchRelationEntityTypes_e
swSketchRelationEntityType_Unknown
= 0
swSketchRelationEntityType_SubSketch
= 1
swSketchRelationEntityType_Point
= 2
swSketchRelationEntityType_Line
= 3
swSketchRelationEntityType_Arc
= 4
swSketchRelationEntityType_Ellipse
= 5
swSketchRelationEntityType_Parabola
= 6
swSketchRelationEntityType_Spline
= 7
swSketchRelationEntityType_Hatch
= 8
swSketchRelationEntityType_Text
= 9
swSketchRelationEntityType_Plane
= 10
swSketchRelationEntityType_Cylinder
= 11
swSketchRelationEntityType_Sphere
= 12
swSketchRelationEntityType_Surface
= 13
swSketchRelationEntityType_Dimension
= 14
End Enum
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swSelData As
SldWorks.SelectData
Dim
swFeat As
SldWorks.feature
Dim
swSketch As
SldWorks.sketch
Dim
swSkRelMgr As
SldWorks.SketchRelationManager
Dim
swSkRel As
SldWorks.SketchRelation
Dim
vSkRelArr As
Variant
Dim
vSkRel As
Variant
Dim
vEntTypeArr As
Variant
Dim
vEntType As
Variant
Dim
vEntArr As
Variant
Dim
vEnt As
Variant
Dim
swSkSeg As
SldWorks.SketchSegment
Dim
swSkPt As
SldWorks.SketchPoint
Dim
i As
Long
Dim
j As
Long
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
Set
swSelData = swSelMgr.CreateSelectData
Set
swFeat = swSelMgr.GetSelectedObject5(1)
Set
swSketch = swFeat.GetSpecificFeature2
Set
swSkRelMgr = swSketch.RelationManager
swModel.ClearSelection2 True
Debug.Print
"File = " & swModel.GetPathName
Debug.Print
" Feat
= " & swFeat.Name
vSkRelArr
= swSkRelMgr.GetRelations(swAll):
If IsEmpty(vSkRelArr) Then Exit Sub
For
Each vSkRel In vSkRelArr
Set
swSkRel = vSkRel
Debug.Print
" Relation("
& i & ")"
Debug.Print
" Type
=
" & swSkRel.GetRelationType
vEntTypeArr
= swSkRel.GetEntitiesType
vEntArr
= swSkRel.GetEntities
Debug.Assert
UBound(vEntTypeArr) = UBound(vEntArr)
j
= 0
For
Each vEntType In vEntTypeArr
Debug.Print
" EntType
=
" & vEntType
Select
Case vEntType
Case
swSketchRelationEntityType_Unknown
Debug.Print
" Not
known"
Case
swSketchRelationEntityType_SubSketch
Debug.Assert
False
Case
swSketchRelationEntityType_Point
Set
swSkPt = vEntArr(j): Debug.Assert Not swSkPt Is Nothing
Debug.Print
" SkPoint
ID = [" & swSkPt.GetId(0)
& ", " & swSkPt.GetId(1)
& "]"
'
SPR 179898
- SketchPoint::Select4 fails
'
if point
is from SketchRelation::GetEntities
'
and does
not exist in sketch
bRet
= swSkPt.Select4(True, swSelData)
': Debug.Assert bRet
Case
swSketchRelationEntityType_Line, _
swSketchRelationEntityType_Arc,
_
swSketchRelationEntityType_Ellipse,
_
swSketchRelationEntityType_Parabola,
_
swSketchRelationEntityType_Spline
Set
swSkSeg = vEntArr(j): Debug.Assert Not swSkSeg Is Nothing
Debug.Print
" SkSeg
ID
= [" & swSkSeg.GetId(0)
& ", " & swSkSeg.GetId(1)
& "]"
bRet
= swSkSeg.Select4(True, swSelData):
Debug.Assert bRet
Case
swSketchRelationEntityType_Hatch
Debug.Assert
False
Case
swSketchRelationEntityType_Text
Debug.Assert
False
Case
swSketchRelationEntityType_Plane
Debug.Assert
False
Case
swSketchRelationEntityType_Cylinder
Debug.Assert
False
Case
swSketchRelationEntityType_Sphere
Debug.Assert
False
Case
swSketchRelationEntityType_Surface
Debug.Assert
False
Case
swSketchRelationEntityType_Dimension
Debug.Assert
False
Case
Else
Debug.Assert
False
End
Select
j
= j + 1
Next
i
= i + 1
Next
End Sub
'---------------------------------------------