Hi I have this code that moves the callout boxes in a certain orientation so that it is not on top of a point but right now it only works for graphics I wanted some help on modifying it so it works for point features and not just graphics.
Private pMxDocument As IMxDocument
Private pFillSymbol As IFillSymbol
Private pRgbColor As IRgbColor
Private pCallout As ILineCallout
Private pTextSymbol As IFormattedTextSymbol
Private CalloutLocation As IPoint
Private IsDecimalDegrees As Boolean
Private xOffset, yOffset As Double
Sub AddGraphicsCoords()
Dim pActiveView As IActiveView
Dim pGraphicsContainer As IGraphicsContainer
Dim pGraphicsContainerSelect As IGraphicsContainerSelect
Dim Ppoint As IPoint
Dim pPtElement As IElement
Dim pCalloutElement As IElement
Dim pEnumElement As IEnumElement
Dim pGFLayer As IGeoFeatureLayer
Set pMxDocument = ThisDocument
' There should be a selection of points. Check.
Set pActiveView = pMxDocument.ActivatedView
Set pGraphicsContainerSelect = pActiveView
Set pGraphicsContainer = pActiveView
If pGraphicsContainerSelect.ElementSelectionCount < 1 Then
MsgBox "You must select some point graphics to label."
Exit Sub
End If
' --------------------------------------------------------------
' Now we can set some default parameters for ALL callout boxes,
' whether feature or graphic-based.
' --------------------------------------------------------------
Set pRgbColor = New RgbColor
With pRgbColor
.Red = 255
.Green = 255
.Blue = 255
End With
' Remember: an IFormattedTextSymbol is an interface on a TextSymbol.
' A TextSymbol contains one TextBackground. A LineCallout is a type of
' Callout, which is a type of TextBackground. Each LineCallout has
' a Border property, which is a SimpleFillSymbol
Set pFillSymbol = New SimpleFillSymbol
pFillSymbol.Color = pRgbColor
Set pCallout = New LineCallout
Set pCallout.AccentBar = Nothing
Set pCallout.Border = pFillSymbol
pCallout.Gap = 0
Set pTextSymbol = New TextSymbol
Set pTextSymbol.Background = pCallout
' Use this boolean later to set coordinate text formatting
If pMxDocument.FocusMap.MapUnits = esriDecimalDegrees Then
IsDecimalDegrees = True
Else
IsDecimalDegrees = False
End If
' Set these so that the callouts don't appear right over the point
xOffset = pMxDocument.ActiveView.Extent.Width / 8
yOffset = pMxDocument.ActiveView.Extent.Width / 20
' Use an enumeration of all the selected points.
Set pEnumElement = pGraphicsContainerSelect.SelectedElements
pEnumElement.Reset
Set pPtElement = pEnumElement.Next
' Loop through each selected element.
While Not pPtElement Is Nothing
If TypeOf pPtElement Is IMarkerElement Then
Set Ppoint = pPtElement.Geometry
Set pCalloutElement = GetCalloutOnPoint(Ppoint)
' Can't call AddElement on an empty Geometry
pGraphicsContainer.AddElement pCalloutElement, 0
pCalloutElement.Activate pActiveView.ScreenDisplay
pActiveView.PartialRefresh esriViewGraphics, pCalloutElement, Nothing
Set pPtElement = pEnumElement.Next
Else
MsgBox "Selection must consist only of points!"
Exit Sub
End If
Wend
Set pFillSymbol = Nothing
Set pRgbColor = Nothing
Set pCallout = Nothing
Set pTextSymbol = Nothing
Set CalloutLocation = Nothing
End Sub
Private Function GetCalloutOnPoint(param_Pt As IPoint) As IElement
' Use point's coordinates to create a new callout.
' Return this as an element, and let calling proc. handle display.
Dim xCoord As Double, xCoordText As String
Dim yCoord As Double, yCoordText As String
Dim pTextElement As ITextElement, outElement As IElement
param_Pt.QueryCoords xCoord, yCoord
If IsDecimalDegrees Then
xCoordText = FormatNumber(xCoord, 5, vbUseDefault, vbUseDefault, vbFalse)
yCoordText = FormatNumber(yCoord, 5, vbUseDefault, vbUseDefault, vbFalse)
Else
xCoordText = FormatNumber(xCoord, 2, vbUseDefault, vbUseDefault, vbFalse)
yCoordText = FormatNumber(yCoord, 2, vbUseDefault, vbUseDefault, vbFalse)
End If
' Use this code to set the offset for the callout box
Set CalloutLocation = New Point
CalloutLocation.PutCoords xCoord - xOffset, yCoord + yOffset
pCallout.AnchorPoint = param_Pt
Set pTextElement = New TextElement
Set outElement = pTextElement
outElement.Geometry = CalloutLocation
pTextElement.Text = xCoordText & vbCrLf & yCoordText
pTextElement.Symbol = pTextSymbol
Set GetCalloutOnPoint = outElement
End Function
