POST
|
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
... View more
11-16-2011
01:31 PM
|
0
|
0
|
720
|
POST
|
Hi, I am trying to build an application that will select stations (one or however many the users enters) and plot them on a map. Right now I know how to do it for one station that the user enters but I am not sure how I would do it for many. I would assume that I need to use a loop function but i am not sure how to go about it. I am not even sure how to set the form up to allow the user to do this also. Any help would be greatly appreciated. Thanks, Linh
... View more
11-15-2011
12:24 PM
|
0
|
0
|
465
|
Online Status |
Offline
|
Date Last Visited |
07-13-2021
08:11 PM
|