Replace Sketch Relation Example (VBA)
This example shows how to reassign a sketch relation from one sketch
line to another.
'--------------------------------------
'
' Preconditions: SolidWorks is running and contains
' Sketch1
and Line4@Sketch1. Sketch1 contains
' a
sketch line that has a horizontal constraint.
'
'
' Postconditions: The
horizontal constraint is reassigned to
' Line4@Sketch1.
The example also changes the suppression states
' of
all of the relations in the sketch.
'
'--------------------------------------
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
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swSelMgr As
SldWorks.SelectionMgr
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
i As
Long
Dim
boolstatus As
Boolean
Dim
result As
Boolean
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
swModel.ClearSelection2 True
boolstatus
= swModel.Extension.SelectByID2("Sketch1",
"SKETCH", 0, 0, 0, False, 0, Nothing, 0)
boolstatus
= swModel.Extension.SelectByID2("Line4@Sketch1",
"EXTSKETCHSEGMENT", -0.003781893521277, 0.02095856938462, 0,
True, 0, Nothing, 1)
Set
swFeat = swSelMgr.GetSelectedObject6(1,
-1)
Set
swSketch = swFeat.GetSpecificFeature2
Set
swSkRelMgr = swSketch.RelationManager
Dim
newEntity As Object
Set
newEntity = swSelMgr.GetSelectedObject6(2,
-1)
Debug.Print
"File = " & swModel.GetPathName
Debug.Print
" Feat
= " & swFeat.Name
vSkRelArr
= swSkRelMgr.GetRelations(swall)
Dim
RelationsCount As Long
RelationsCount
= swSkRelMgr.GetRelationsCount(swall)
Debug.Print
" There
are " & RelationsCount & " relations"
For
Each vSkRel In vSkRelArr
Set
swSkRel = vSkRel
Debug.Print
" Relation("
& i & ")"
Debug.Print
" Type
=
" & swSkRel.GetRelationType
Dim
EntitiesCount As Long
Dim
vEntities As Variant
EntitiesCount
= swSkRel.GetEntitiesCount
Debug.Print
" Entities
count is " & EntitiesCount
If
(swSkRel.GetRelationType = 4)
Then
vEntities
= swSkRel.GetEntities
swModel.ClearSelection2 True
Dim
Entity As SldWorks.Entity
Dim
oldEntity As Object
Dim
SketchSeg As SldWorks.SketchSegment
Dim
SketchPt As SldWorks.SketchPoint
Set
Entity = Nothing
Set
SketchSeg = Nothing
Set
SketchPt = Nothing
On
Error Resume Next
Set
oldEntity = vEntities(0)
result
= swSkRel.ReplaceEntity(oldEntity,
newEntity)
End
If
result
= swSkRel.Suppressed
Debug.Print
" Suppressed
=
" & result
If
(result) Then
swSkRel.Suppressed = False
Else
swSkRel.Suppressed = True
End
If
Debug.Print
" Suppressed
=
" & swSkRel.Suppressed
i
= i + 1
Next
End Sub
'---------------------------------------------