BUG
In ArcGIS 9.2, some annotation feature classes display at angles that contradict their bounding box.
Checking the angle set for the feature in the attribute table does not fix this issue.
The two-point text baselines for annotation features is too small. When an annotation feature class uses a two-point text baseline, the angle is derived from these points.
When the annotation feature class is snapped to the new high precision spatial reference, the tiny positional change results in a massively different text angle.
Note: Code in ThisDocument module only runs in the current map document. To store the code in all map documents, open the Normal.mxt ThisDocument code module.
Option Explicit 'Set this flag to false to make a one point baseline, otherwise it'll make 'a two point baselines which is generally desired Private Const MakeTwoPoint As Boolean = True Public Sub SmallBaselineToOneorTwoPointBaseline() Dim pApp As IApplication Dim pEditor As IEditor Dim pMxDoc As IMxDocument Dim pEnumFeature As IEnumFeature Dim pAnnoFeat As IAnnotationFeature Dim pElement As IElement Dim pPolyline As IPolyline Dim pFeature As IFeature Dim pGeometry As IGeometry Dim Count As Integer Dim pID As New UID Dim pPointCollection As IPointCollection pID = "esriEditor.Editor" Set pApp = Application Set pMxDoc = pApp.Document Set pEditor = pApp.FindExtensionByCLSID(pID) If pEditor.EditState = esriStateNotEditing Then MsgBox "Please start an edit session and select annotation features." Exit Sub End If Set pEnumFeature = pEditor.EditSelection pEnumFeature.Reset pEditor.StartOperation Set pFeature = pEnumFeature.Next For Count = 0 To pEditor.SelectionCount - 1 If TypeOf pFeature Is IAnnotationFeature Then Set pAnnoFeat = pFeature Set pElement = pAnnoFeat.Annotation If TypeOf pElement Is ITextElement Then Set pGeometry = pElement.Geometry If TypeOf pGeometry Is IPolyline Then Set pPointCollection = pGeometry If pPointCollection.PointCount = 2 Then If MakeTwoPoint = True Then pAnnoFeat.Annotation = MakeTwoPointGeometry(pElement, pFeature.Shape) Else pElement.Geometry = MakeOnePointGeometry(pElement) pAnnoFeat.Annotation = pElement End If pFeature.Store Debug.Print "Updated Feature: " & pFeature.OID End If End If End If End If Set pFeature = pEnumFeature.Next Next Count pEditor.StopOperation ("Update text with small two point baselines to proper geometries") Dim pActiveView As IActiveView Set pActiveView = pMxDoc.ActiveView pActiveView.PartialRefresh esriViewGeography, Nothing, pActiveView.extent End Sub Private Function MakeOnePointGeometry(pTextElement As ITextElement) As IGeometry Dim pElement As IElement Set pElement = pTextElement Dim pGeometry As IGeometry Dim pPolyline As IPolyline Set pGeometry = pElement.Geometry If TypeOf pGeometry Is IPolyline Then Set pPolyline = pGeometry Else MsgBox "This function only works with polyline text element geometries" End If Dim pPoint As IPoint Set pPoint = New Point Set pPoint.SpatialReference = pGeometry.SpatialReference Dim horzAlign As esriTextHorizontalAlignment 'generate the correct point based on the horzizontal alignment Select Case horzAlign Case esriTHALeft pPolyline.QueryFromPoint pPoint Case esriTHARight pPolyline.QueryToPoint pPoint Case Else 'esriTHACenter and esriTHAFull pPolyline.QueryPoint esriNoExtension, 0.5, True, pPoint 'get midpoint End Select Set MakeOnePointGeometry = pPoint End Function Private Function MakeTwoPointGeometry(pTextElement As ITextElement, pPolygon As IPolygon) As IElement 'with a rectangluar shape of the elements bounds 'we'll delete all but two points from the polygon 'and then make a line from it Dim pPointColl As IPointCollection Set pPointColl = pPolygon 'remove points 5,1,2 leaving points 0 and 4 (the lower left and right corners) pPointColl.RemovePoints 4, 1 pPointColl.RemovePoints 1, 2 'make a new polyline from the point collection Dim pPointColl2 As IPointCollection Set pPointColl2 = New Polyline pPointColl2.AddPointCollection pPointColl 'set the geometry of the text element to be the polyline 'this will make it a two point textpath Dim pElement As IElement Set pElement = pTextElement pElement.Geometry = pPointColl2 Set pTextElement = pElement Dim pSymbolCollectionElement As ISymbolCollectionElement 'we need to reset the offset and vertical alignment because the feature shape doesn't 'represent it. Otherwise, the text will move if it has offsets Set pSymbolCollectionElement = pTextElement pSymbolCollectionElement.XOffset = 0 pSymbolCollectionElement.YOffset = 0 pSymbolCollectionElement.VerticalAlignment = esriTVABottom Set MakeTwoPointGeometry = pElement End Function
Get help from ArcGIS experts
Download the Esri Support App