Attach Annotation to Entity Example (VBA)
This example shows how to move an annotation from one entity to another.
'----------------------------------------------
'
' Preconditions: Part or drawing is open that has
' annotations.
'
' Postconditions: If possible, the selected annotation
is moved to
' the
selected entity (i.e., face, edge, or vertex.
'
'-----------------------------------------------
Option Explicit
Public Enum swAnnotationType_e
swCThread
= 1
swDatumTag
= 2
swDatumTargetSym
= 3
swDisplayDimension
= 4
swGTol
= 5
swNote
= 6
swSFSymbol
= 7
swWeldSymbol
= 8
swCustomSymbol
= 9
swDowelSym
= 10
swLeader
= 11
swBlock
= 12
swCenterMarkSym
= 13
swTableAnnotation
= 14
swCenterLine
= 15
End Enum
Public Enum swSelectType_e
swSelNOTHING
= 0
swSelEDGES
= 1 '
"EDGE"
swSelFACES
= 2 '
"FACE"
swSelVERTICES
= 3 '
"VERTEX"
swSelSKETCHSEGS
= 10 '
"SKETCHSEGMENT"
swSelSKETCHPOINTS
= 11 '
"SKETCHPOINT"
swSelGTOLS
= 13 '
"GTOL"
swSelDIMENSIONS
= 14 '
"DIMENSION"
swSelNOTES
= 15 '
"NOTE"
swSelCENTERMARKS
= 28 '
"CENTERMARKS"
swSelSFSYMBOLS
= 35 '
"SFSYMBOL"
swSelDATUMTAGS
= 36 '
"DATUMTAG"
swSelCTHREADS
= 39 '
"CTHREAD"
swSelDTMTARGS
= 40 '
"DTMTARG"
swSelBLOCKINST
= 93 '
"BLOCKINST"
swSelCENTERMARKSYMS
= 100 '
"CENTERMARKSYMS"
swSelCENTERLINES
= 103 '
"CENTERLINE"
End Enum
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swSelObj1 As
Object
Dim
swSelObj2 As
Object
Dim
swAnn As
SldWorks.Annotation
Dim
vAttEntTypeArr As
Variant
Dim
vAttEntArr As
Variant
Dim
nSelType As
Long
Dim
i As
Long
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
'
Select the annotation to move
Set
swSelObj1 = swSelMgr.GetSelectedObject6(1,
-1)
Set
swAnn = swSelObj1.GetAnnotation
'
Part - select the entity to move the annotation to
Set
swSelObj2 = swSelMgr.GetSelectedObject6(2,
-1)
'
Drawing - select the entity to move the annotation to
'Set
swSelObj2 = swSelMgr.GetSelectedObject6(3,
-1)
Dim
AttEntArr(0) As Object
Set
AttEntArr(0) = swSelObj2
Dim
vAttEntArrIn As Variant
vAttEntArrIn
= AttEntArr
bRet
= swAnn.SetAttachedEntities(vAttEntArrIn)
Debug.Print
"Name =
" & swAnn.GetName
Debug.Print
" Selection
Type =
" & swSelMgr.GetSelectedObjectType3(1,
-1)
Debug.Print
" Annotation
Type = " & swAnn.GetType
vAttEntArr
= swAnn.GetAttachedEntities2
vAttEntTypeArr
= swAnn.GetAttachedEntityTypes
If
Not IsEmpty(vAttEntTypeArr) Then
Debug.Assert
UBound(vAttEntArr) = UBound(vAttEntTypeArr)
For
i = 0 To UBound(vAttEntTypeArr)
'
A dangling dimension has at least one entity of type swSelNOTHING
Debug.Print
" Entity
Type(" & i & ") =
" & vAttEntTypeArr(i)
Dim
swSelData As
SldWorks.SelectData
Set
swSelData = swSelMgr.CreateSelectData
Call
vAttEntArr(i).Select4(False, swSelData)
Next
i
End
If
End Sub