Convert Annotation to Polygon Features

Created:7/23/2002
Description:

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.
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 S