Home arrow GIS Data & Resources arrow Scripts and Code arrow Visual Basic / VBA arrow VBA: Move Annotation & Check Containment
VBA: Move Annotation & Check Containment PDF Print E-mail

Written by Bert Granberg,

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                     

Annotation Move BEFORE   Annotation Move AFTER

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
       
       
        annoUpperLeft_X = pAnnoElement.Geometry.Envelope.XMin
        annoUpperLeft_Y = pAnnoElement.Geometry.Envelope.YMax
       
        'only works with feature linked annotation features
        If pAnnoFeature.LinkedFeatureID >= 0 Then
       
            Set pPolyFeature = pPolyFeatureClass.GetFeature(pAnnoFeature.LinkedFeatureID)
                   
            polyUpperLeft_X = pPolyFeature.Extent.XMin + OffSetX
            polyUpperLeft_Y = pPolyFeature.Extent.YMax + OffSetY
           
            Set pTransform2d = pAnnoElement 'QI
   
            'move annotation
            pTransform2d.Move (polyUpperLeft_X - annoUpperLeft_X), _
                              (polyUpperLeft_Y - annoUpperLeft_Y)
                    
           
            '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
           
                pFeature.Value(pAnnoFeatureClass.FindField("FeatureID")) = -1
           
            Else
               
                pFeature.Value(pAnnoFeatureClass.FindField("FeatureID")) = -2
           
            End If
                    
            pAnnoFeature.Annotation = pAnnoElement
            'pFeature.Store
            pFeatureCursor.UpdateFeature pFeature


        End If
       
        Set pFeature = pFeatureCursor.NextFeature
       
    Loop
   
    If editStart 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
   
End Sub


Users' Comments  
 

No comment posted

Add your comment

23, May. 2008
Last Updated ( 23, May. 2008 )
 
< Prev   Next >

AGRC Contacts | UGIC Contacts

feed image feed image

Utah GIS Portal © 2009 AGRC

Optimized for