This script will move feature-linked annotation to a location determined by 2 hard coded-offset distance parameters from the upper left corner of the linked feature's extent.
The script as written contains a conditional statement that will UNLINK the annotation from the feature providing a -1 FeatureID value if the 'annotation is contained by its linked feature and a -2 FeatureID value if the 'annotation is not contained by its linked feature.
Annotation Before Move Annotation After Move
Public Sub annoMoveToLinkedFeaturesUpperCorner()
'05/23/08 AGRC-BG
'This script will move feature-linked annotation to a location determined by a 'user provided offset from the upper left corner of the linked feature's extent.
'IMPORTANT: The script as written contains a conditional statement that will 'UNLINK the annotation from the feature providing a -1 FeatureID value if the 'annotation is contained by its linked feature and a -2 FeatureID value if the 'annotation is not contained by its linked feature.
'You will need to provide layer index numbers and offsets by editing the script 'below where you see the **** characters
Dim pMxDoc As IMxDocument Dim pMap As IMap Dim pActiveView As IActiveView
Dim pAnnoFeatureLayer As IFeatureLayer Dim pAnnoFeatureClass As IFeatureClass Dim pFeature As IFeature Dim pAnnoFeature As IAnnotationFeature Dim pAnnoElement As IElement
Dim pPolyFeatureLayer As IFeatureLayer Dim pPolyFeatureClass As IFeatureClass Dim pPolyFeature As IFeature
Dim pFeatureCursor As IFeatureCursor
Dim annoUpperLeft_X As Double Dim annoUpperLeft_Y As Double Dim polyUpperLeft_X As Double Dim polyUpperLeft_Y As Double Dim pTransform2d As ITransform2D Dim OffSetX As Double Dim OffSetY As Double Dim pRelOperator As IRelationalOperator
Dim pEditor As IEditor Dim pID As New UID Dim editStart As Boolean
'Get a reference to the editor extension pID = "esriEditor.Editor" Set pEditor = Application.FindExtensionByCLSID(pID)
If pEditor.EditState = esriStateNotEditing Then
MsgBox "You must be in an edit session to use this script", _ vbOKOnly, "Error-Exiting..." Exit Sub
End If
Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap Set pActiveView = pMap
'PARAMETERS
'**** Specify offset distances here (from upper left corner of linked polygon) OffSetX = 100 OffSetY = -300
'**** Specify layer position in the table of contents Set pAnnoFeatureLayer = pMap.Layer(0) Set pPolyFeatureLayer = pMap.Layer(1)
Set pAnnoFeatureClass = pAnnoFeatureLayer.FeatureClass Set pPolyFeatureClass = pPolyFeatureLayer.FeatureClass
Set pFeatureCursor = pAnnoFeatureClass.Update(Nothing, True) Set pFeature = pFeatureCursor.NextFeature
editStart = False If Not pFeature Is Nothing Then
pEditor.StartOperation editStart = True End If
Do Until pFeature Is Nothing
Set pAnnoFeature = pFeature 'QI Set pAnnoElement = pAnnoFeature.Annotation
'Unlink Annotation by setting featureID field to -1 for contained 'annotation and -2 for problem annotation Set pRelOperator = pPolyFeature.Shape If pRelOperator.Contains(pAnnoElement.Geometry) Then
pEditor.StopOperation "VBA: Move Annotation" MsgBox "Annotation moved and unlinked. Remember to inspect results and " _ & "save your edits", vbOKOnly, "Complete..." pActiveView.Refresh End If