Solved! Go to Solution.
Public Sub printLabels() ' Get layer Dim pMXD As IMxDocument Set pMXD = ThisDocument Dim pMap As IMap Set pMap = pMXD.FocusMap Dim pLayer As ILayer Set pLayer = pMap.Layer(0) Dim pGeoFeaturelayer As IGeoFeatureLayer Set pGeoFeaturelayer = pLayer ' Get annotation collection Dim pAnnotateLayerPropertiesCollection As IAnnotateLayerPropertiesCollection Set pAnnotateLayerPropertiesCollection = pGeoFeaturelayer.AnnotationProperties ' Assumes 1 item in collection Dim pAnnotateLayerProperties As IAnnotateLayerProperties pAnnotateLayerPropertiesCollection.QueryItem 0, pAnnotateLayerProperties, Nothing, Nothing ' Get label engine and then the expression Dim pLabelEngineLayerProps As ILabelEngineLayerProperties Set pLabelEngineLayerProps = pAnnotateLayerProperties Dim simpleExpression As String Let simpleExpression = pLabelEngineLayerProps.Expression ' Get expression engine and create parser Dim pAnnotationExpressionEngine As IAnnotationExpressionEngine Set pAnnotationExpressionEngine = pLabelEngineLayerProps.ExpressionParser Dim pAnnotationExpressionParser As IAnnotationExpressionParser Set pAnnotationExpressionParser = pAnnotationExpressionEngine.SetExpression("", simpleExpression) ' Loop through featurelayer printing to VBA immediate window the label as seen on map Dim pFeatureCursor As IFeatureCursor Set pFeatureCursor = pGeoFeaturelayer.Search(Nothing, True) Dim pFeature As IFeature Set pFeature = pFeatureCursor.NextFeature Do While Not pFeature Is Nothing Debug.Print pAnnotationExpressionParser.FindLabel(pFeature) Set pFeature = pFeatureCursor.NextFeature Loop End Sub
Public Sub printLabels() ' Get layer Dim pMXD As IMxDocument Set pMXD = ThisDocument Dim pMap As IMap Set pMap = pMXD.FocusMap Dim pLayer As ILayer Set pLayer = pMap.Layer(0) Dim pGeoFeaturelayer As IGeoFeatureLayer Set pGeoFeaturelayer = pLayer ' Get annotation collection Dim pAnnotateLayerPropertiesCollection As IAnnotateLayerPropertiesCollection Set pAnnotateLayerPropertiesCollection = pGeoFeaturelayer.AnnotationProperties ' Assumes 1 item in collection Dim pAnnotateLayerProperties As IAnnotateLayerProperties pAnnotateLayerPropertiesCollection.QueryItem 0, pAnnotateLayerProperties, Nothing, Nothing ' Get label engine and then the expression Dim pLabelEngineLayerProps As ILabelEngineLayerProperties Set pLabelEngineLayerProps = pAnnotateLayerProperties Dim simpleExpression As String Let simpleExpression = pLabelEngineLayerProps.Expression ' Get expression engine and create parser Dim pAnnotationExpressionEngine As IAnnotationExpressionEngine Set pAnnotationExpressionEngine = pLabelEngineLayerProps.ExpressionParser Dim pAnnotationExpressionParser As IAnnotationExpressionParser Set pAnnotationExpressionParser = pAnnotationExpressionEngine.SetExpression("", simpleExpression) ' Loop through featurelayer printing to VBA immediate window the label as seen on map Dim pFeatureCursor As IFeatureCursor Set pFeatureCursor = pGeoFeaturelayer.Search(Nothing, True) Dim pFeature As IFeature Set pFeature = pFeatureCursor.NextFeature Do While Not pFeature Is Nothing Debug.Print pAnnotationExpressionParser.FindLabel(pFeature) Set pFeature = pFeatureCursor.NextFeature Loop End Sub