How to convert annotation to polygon features

This sample converts geodatabase annotation features into ESRI polygon features. The geometry of each annotation feature is converted as a multi-ring polygon feature and stored as a new feature in a provided polygon feature class.

How to use

  1. In ArcMap, open a document and add any polygon shapefile or personal geodatabase featureclass. Open an annotation featureclass (coverage annotation is not supported).
  2. In the Visual Basic Editor, copy-paste this sample's code into a module. Change the "USER SETTINGS" variables at the top of the code to suit your needs.
  3. Run the AnnoPolyCon_Click procedure.
[VBA] 
Private Sub AnnoPolyCon_Click()
    Dim FLayerNum As Long
    Dim FDOLayerNum As Long
    Dim ReferenceScale As Double
    Dim MapScale As Double
    Dim OutputDPI As Double
    Dim OptimumScale As Double
    Dim ScreenResolution As Double
    Dim AnnoScaleFactor As Double
    Dim TempTextSize As Double
    Dim FinalOutputScale As Double
    
    'USER SETTINGS
    'SET these variables for your individual case
    FDOLayerNum = 0 'Set annotation layer here (zero-based: 0 is first layer in TOC)
    FLayerNum = 1 'Set empty feature layer here (zero-based: 1 is second layer in TOC)
    OutputDPI = 1200 'Highest DPI of your final output device(s)
    ScreenResolution = 96 'Resolution of your monitor
    FinalOutputScale = 24000 'Final scale that your map will be printed with
    
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    
    Dim pMap As IMap
    Set pMap = pMxDoc.FocusMap
    
    Dim pActiveView As IActiveView
    Set pActiveView = pMap
    
    Dim pScreenDisplay As IScreenDisplay
    Set pScreenDisplay = pActiveView.ScreenDisplay
    
    Dim pDisplayTransform As IDisplayTransformation
    Set pDisplayTransform = pScreenDisplay.DisplayTransformation
    
    Dim pFLayer As IFeatureLayer
    Set pFLayer = pMap.Layer(FLayerNum)
    
    Dim pFClass As IFeatureClass
    Set pFClass = pFLayer.FeatureClass
    
    Dim pClass As IClass
    Set pClass = pMap.Layer(FDOLayerNum)
    
    Dim pAnnoClass As IAnnoClass
    Set pAnnoClass = pClass.Extension
    
    Dim pAnnoFeature As IFeature
    Dim pAnnoElement As IElement
    
    ReferenceScale = pMap.ReferenceScale
    MapScale = pMap.MapScale
    OptimumScale = (ScreenResolution / OutputDPI) * (FinalOutputScale / 2)
    AnnoScaleFactor = pAnnoClass.ReferenceScale / OptimumScale
    
    Dim pFDOGraphicsLayer As IFDOGraphicsLayer
    Set pFDOGraphicsLayer = pMap.Layer(FDOLayerNum)
    
    Dim pFDOGraphicsRead As IFDOGraphicsLayerRead
    Set pFDOGraphicsRead = pFDOGraphicsLayer
    pMap.ReferenceScale = 0
    pMap.MapScale = OptimumScale
    
    'Generate graphacigs for
    pFDOGraphicsRead.StartGeneratingGraphics Nothing, pScreenDisplay, True, True, False
    
    Set pAnnoElement = pFDOGraphicsRead.NextGraphic
    Do Until pAnnoElement Is Nothing
        
        Dim pPolygon As IPolygon
        Set pPolygon = New Polygon
        
        Dim pTextElement As ITextElement
        Set pTextElement = pAnnoElement
        
        Dim pTextSymbol As ITextSymbol
        Set pTextSymbol = pTextElement.Symbol
        
        'Temporarily change textsymbol's size
        TempTextSize = pTextSymbol.Size
        pTextSymbol.Size = TempTextSize * AnnoScaleFactor
        
        Dim pTextQuery As IQueryGeometry
        Set pTextQuery = pTextSymbol
        
        Dim pTextPointGeo As IGeometry
        Set pTextPointGeo = pAnnoElement.Geometry
        
        'Setup screen for drawing
        pScreenDisplay.StartDrawing pScreenDisplay.WindowDC, pScreenDisplay.ActiveCache
        
        'Get ESRI geometry from Text
        Set pPolygon = pTextQuery.GetGeometry(pScreenDisplay.WindowDC, pDisplayTransform, pTextPointGeo)
        
        'Ensure geometry is suitable for a feature (sorts inner/outter rings)
        Dim pTopoOperator2 As ITopologicalOperator2
        Set pTopoOperator2 = pPolygon
        
        pTopoOperator2.IsKnownSimple = False
        pPolygon.SimplifyPreserveFromTo
        
        pScreenDisplay.FinishDrawing
        
        'Restore textsymbol size
        pTextSymbol.Size = TempTextSize
        
        'Store geometry in a feature
        Dim pFeature As IFeature
        Set pFeature = pFClass.CreateFeature
        Set pFeature.Shape = pPolygon
        pFeature.Store
        
        'Move to next piece of anno and loop
        Set pAnnoElement = pFDOGraphicsRead.NextGraphic
    Loop
    
    'Restore dataframe's previous extent
    pMap.ReferenceScale = ReferenceScale
    pMap.MapScale = MapScale
    pActiveView.Refresh
    
End