label与Annotation有关的代码

How to use:
Add a Geodatabase feature class to ArcMap. Set labeling properties on layer.
Copy/paste the macro code into VBA.
Run the macro.
          

Option Explicit

Const ANNO_FC_NAME = "Conversion01" 'the name that will be used for the new annotation feature class

Public Sub ConvertLabels2Anno()
  'Interface Pointers necessary for accessing basic information about the map
  Dim pMxDoc As IMxDocument
  Dim pMap As IMap
  Dim pAView As IActiveView
  
  'Interface Pointers necessary for getting information about the layer being labeled
  Dim pLayer As ILayer
  Dim pDataset As IDataset
  Dim pAnnotationLayer As IAnnotationLayer
  Dim pGeoFeatureLayer As IGeoFeatureLayer
  Dim pFClass As IFeatureClass
  Dim pAnnoLayer As IAnnotationLayer
  Dim pWorkspace As IWorkspace
  Dim pGeoDataset As IGeoDataset
  Dim pESRILicenseInfo As IESRILicenseInfo
  Dim bIsArcView As Boolean

  'Interface Pointers necessary for setting up the labeling properties for conversion
  Dim pAnnotateLayerPropertiesCollection As IAnnotateLayerPropertiesCollection
  Dim pMapAnnoPropsColl As IAnnotateLayerPropertiesCollection
  Dim pAnnotateLayerProperties As IAnnotateLayerProperties
  Dim pLabelEngineLayerProperties As ILabelEngineLayerProperties2
  Dim pOverposterLayerProperties As IOverposterLayerProperties2
  Dim propsIndex As Long
  Dim pSymbolClone As IClone
  
  'Interface Pointers necessary for creating the annotation feature class
  Dim pRefScale As IGraphicsLayerScale
  Dim pSymCol As ISymbolCollection2
  Dim pSymbolIdentifier As ISymbolIdentifier2
  Dim pAnnotationLayerFactory As IAnnotationLayerFactory
  Dim pAnnoFeatureClassDesc As IFeatureClassDescription
  Dim pAnnoObjectClassDesc As IObjectClassDescription
  Dim pFields As IFields 'pointer needed for pointer needed
  Dim pField As IField
  Dim pGeomDefEdit As IGeometryDefEdit
  
  'Interface Pointers necessary for performing labeling
  Dim pScreenDisplay As IScreenDisplay
  Dim pGraphicsLayer As IGraphicsLayer
  Dim pAnnotateMapProps As IAnnotateMapProperties
  Dim pAnnotateMap2 As IAnnotateMap2
  Dim pTrackCancel As ITrackCancel
  Dim pMapOverposter As IMapOverposter
  Dim pOverposterProperties As IOverposterProperties

  'setup the document, map, and get the first layer
  Set pMxDoc = ThisDocument
  Set pMap = pMxDoc.FocusMap
  Set pLayer = pMap.Layer(0)
  
    'check to make sure map is valid
  If pMap Is Nothing Then
    MsgBox "There is not an active map", vbCritical
    Exit Sub
  End If
  
  'see if the first layer is the proper type
  If TypeOf pLayer Is IGeoFeatureLayer Then
    Set pGeoFeatureLayer = pLayer
  Else
  'throw an error if the first layer is not a GeoFeatureLayer because only layers implementing this interface can be labeled
    MsgBox "First layer in map must be feature layer", vbCritical
  End If

  'check to see if we are beginning with a GDB based layer.  This sample creates an annotation
  'feature class in the same workspace and we can only create annotation in GDB workspaces
  Set pDataset = pGeoFeatureLayer
  Set pWorkspace = pDataset.Workspace
  If pWorkspace.Type = esriFileSystemWorkspace Then
      MsgBox "The layer being labeled is not a layer for a Geodatabase Feature Class.", vbCritical
    Exit Sub
  End If
  
  'see what license we are working with
  Set pESRILicenseInfo = New ESRILicenseInfo
  If pESRILicenseInfo.DefaultProduct = esriProductCodeViewer Then
    bIsArcView = True
  End If
  

  'get a reference to the layers feature class and QI to IGeoDataset to get spatial reference information
  Set pFClass = pGeoFeatureLayer.FeatureClass
  Set pGeoDataset = pFClass
  
  'cocreate a new objects
  Set pAnnotationLayerFactory = New FDOGraphicsLayerFactory 'Factory for creating annotation feature classes
  Set pSymCol = New SymbolCollection 'the symbol collection needed for the annotation feature class
  Set pMapAnnoPropsColl = New AnnotateLayerPropertiesCollection 'a new properties collection which will be populated
  
  'loop through the properties collection of the layer
  'for each item, copy it to the new properties collection,
  'pull the symbol out for the SymbolCollection, and setup the ID
  Set pAnnotateLayerPropertiesCollection = pGeoFeatureLayer.AnnotationProperties
  For propsIndex = 0 To (pAnnotateLayerPropertiesCollection.Count - 1)
    pAnnotateLayerPropertiesCollection.QueryItem propsIndex, pAnnotateLayerProperties
    If Not pAnnotateLayerProperties Is Nothing Then
      pMapAnnoPropsColl.Add pAnnotateLayerProperties
      Set pLabelEngineLayerProperties = pAnnotateLayerProperties
      Set pSymbolClone = pLabelEngineLayerProperties.Symbol
      pSymCol.AddSymbol pSymbolClone.Clone, pAnnotateLayerProperties.Class  & " " &  propsIndex, pSymbolIdentifier
      pLabelEngineLayerProperties.SymbolID = pSymbolIdentifier.ID
    End If
  Next propsIndex
  
  'clear the pointers for later use in the sub
  Set pAnnotateLayerProperties = Nothing
  Set pLabelEngineLayerProperties = Nothing
  
  'setup GraphicsLayerScale for use in creating the annotation feature class
  Set pRefScale = New GraphicsLayerScale
  If pMap.ReferenceScale = 0 Then
    pRefScale.ReferenceScale = pMap.MapScale
  Else
    pRefScale.ReferenceScale = pMap.ReferenceScale
  End If
  pRefScale.Units = pMap.MapUnits
  
  'Use AnnotationFeatureClassDescription to get the list of fields needed for the annotation feature class
  'Also, pull out the shape field and setup the spatial reference to equal the base feature layer
  Set pAnnoFeatureClassDesc = New AnnotationFeatureClassDescription
  Set pAnnoObjectClassDesc = pAnnoFeatureClassDesc
  Set pFields = pAnnoObjectClassDesc.RequiredFields
  Set pField = pFields.Field(pFields.FindField(pAnnoFeatureClassDesc.ShapeFieldName)) 'get the field definition for the shape field
  Set pGeomDefEdit = pField.GeometryDef 'get the geometry defintion for the field
  Set pGeomDefEdit.SpatialReference = pGeoDataset.SpatialReference 'set the spatial reference on the field
  
  'get the overposter (label engine) properties from the map
  Set pMapOverposter = pMap
  Set pOverposterProperties = pMapOverposter.OverposterProperties
  
  'Now, create the annotation feature class with this method by passing in all the information
  'a reference to the layer is returned so that we can populate the feature class
  'The ArcView license case does not have to be treated differently here because the Factory internally
  'handles it.  If working with an ArcView license, only one annotation class will be created
  'Pass in Nothing for the related feature class because this sample does not create feature-linked anno
  Set pAnnoLayer = pAnnotationLayerFactory.CreateAnnotationLayer(pWorkspace, pFClass.FeatureDataset, _
  ANNO_FC_NAME, pGeomDefEdit, Nothing, pMapAnnoPropsColl, pRefScale, pSymCol, True, True, False, True, pOverposterProperties, "")

  'activate the graphics container (AnnoLayer) for adding elements.
  Set pAView = pMap
  Set pScreenDisplay = pAView.ScreenDisplay
  Set pGraphicsLayer = pAnnoLayer
  pGraphicsLayer.Activate pScreenDisplay
    
  'Prepare the annotation properties for label placement
  For propsIndex = 0 To (pMapAnnoPropsColl.Count - 1)
    pMapAnnoPropsColl.QueryItem propsIndex, pAnnotateLayerProperties       'get the properties from the collection
    If Not pAnnotateLayerProperties Is Nothing Then
      Set pAnnotateLayerProperties.FeatureLayer = pGeoFeatureLayer         'point the properties to the feature layer
      Set pAnnotateLayerProperties.GraphicsContainer = pAnnoLayer          'set the AnnoLayer as the destination for the labels
      pAnnotateLayerProperties.AddUnplacedToGraphicsContainer = True       'add the unplaced labels to the Annotation Feature Class
      pAnnotateLayerProperties.CreateUnplacedElements = True               'ALWAYS create unplaced elements
      pAnnotateLayerProperties.DisplayAnnotation = True                    'turn on the label class if it isn't already
      pAnnotateLayerProperties.FeatureLinked = False                       'This sample creates standard annotation, so set this to false
      pAnnotateLayerProperties.LabelWhichFeatures = esriAllFeatures        'this creates labels/anno for the full extent. This can be changed to produce labels for the current extent, selection etc
      pAnnotateLayerProperties.UseOutput = True                            ' yes, we want to produce elements
      Set pLabelEngineLayerProperties = pAnnotateLayerProperties           'QI to LabelEngineLayerProperties
      pLabelEngineLayerProperties.SymbolID = propsIndex           'Since a New Annotation FeatureClass was created, the propsIndex will be the same as the SymbolID
      'ArcView does not support multiple annotation classes, therefore see if we have an ArcView license
      'and set the AnnotationClassID to 0 if it is ArcView, so annotation features are assigned to the proper class
        If bIsArcView Then
          pLabelEngineLayerProperties.AnnotationClassID = 0
        Else
          pLabelEngineLayerProperties.AnnotationClassID = propsIndex
        End If
      Set pOverposterLayerProperties = pLabelEngineLayerProperties.OverposterLayerProperties 'Get the overposter layer properties from the LabelEngineLayerProps
      pOverposterLayerProperties.TagUnplaced = True               'add unplaced labels as unplaced (true) or placed (false)
    End If
  Next propsIndex
  
  'sort the collection so labels are placed in the proper order
  pMapAnnoPropsColl.Sort
  
  'populate AnnotateMapProperties with the prepared collection
  Set pAnnotateMapProps = New AnnotateMapProperties
  Set pAnnotateMapProps.AnnotateLayerPropertiesCollection = pMapAnnoPropsColl
  
  
  Set pTrackCancel = New CancelTracker 'cocreat a cancel tracker
  
  'get the current AnnotateMap object from the map
  'this ensures we are using the proper label engine
  Set pAnnotateMap2 = pMap.AnnotationEngine
  
  'Now, call Label which will populate the annotation feature class with labels based on the properties we setup
  'The Label method know to put the labels in the annotation feature class because we specified the Anno Layer
  'as the destination GraphicsContainer in the above preparation loop
  pAnnotateMap2.Label pOverposterProperties, pAnnotateMapProps, pMap, pTrackCancel
  
  'release the feature layer reference in the properties collection to be safe
  'in some cases, not doing this would lead to a circular reference
  For propsIndex = 0 To (pMapAnnoPropsColl.Count - 1)
    pMapAnnoPropsColl.QueryItem propsIndex, pAnnotateLayerProperties
    If Not pAnnotateLayerProperties Is Nothing Then
      Set pAnnotateLayerProperties.FeatureLayer = Nothing
    End If
  Next propsIndex
  
  'add layer to map and turn off labeling of feature layer
  pMap.AddLayer pAnnoLayer
  pGeoFeatureLayer.DisplayAnnotation = False

  'refresh the map
  Set pAView = pMap
  pAView.Refresh
  
End Sub