A route is simply a Polyline feature with measures. This tool allows you to click anywhere on a map. The route and measure information for all route features that are within the map's search tolerance of the clicked point will be displayed in a message box.
Note that if you right-click a route layer in ArcMap's table of contents and click Properties, the Layer Properties dialog has a Routes tab. On that tab, you can choose the Route Identifier field, whose contents uniquely identifes each route. The values in this field are used, in part, to construct the string that is displayed in the message box that appears.
How to use
- Add one or more route (Polyline with measures) layers to your map.
- Add a new UIToolControl to any toolbar.
- Paste the code into the UIToolControl's mouse down event.
- Make sure the names of the controls match. This example assumes UIToolControl1.
- Select the newly added tool and click on any route in your map.
Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal X As Long, ByVal Y As Long)
On Error GoTo eh
'+++ Each route layer (Polyline with Ms) automatically has a route layer extension
'+++ attached to it when it is added to ArcMap. This example steps through all the
'+++ layers in the focus map. For each layer that has a route layer extension, the
'+++ route location(s) at the user-defined mouse click will be displayed in a
'+++ message box.
If Not button = 1 Then Exit Sub '+++ make sure it is the left button
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pLayer As ILayer
Dim pFLayer As IFeatureLayer
Dim pDS As IDataset
Dim pLayerExt As ILayerExtensions
Dim pRtLayerExt As IRouteLayerExtension
Dim pEnvelope As IEnvelope
Dim pRtLocator As IRouteLocator2
Dim pRtLoc As IRouteLocation2
Dim pRMPointLoc As IRouteMeasurePointLocation
Dim pFeat As IFeature
Dim pName As IName
Dim pEnum As IEnumRouteIdentifyResult
Dim Str As String
Dim i As Long, j As Long
'+++ Get the focus map
Set pMxApp = Application
Set pMxDoc = Application.Document
Set pMap = pMxDoc.FocusMap
'+++ Create an envelope out of the map's current location and expand it by the
'+++ search tolerance
Set pEnvelope = pMxDoc.CurrentLocation.Envelope
pEnvelope.Expand pMxDoc.SearchTolerance, pMxDoc.SearchTolerance, False
'+++ Step through the layers. For each layer that has a route layer extension
'+++ get the route location(s) where the mouse was clicked.
For i = 0 To pMap.LayerCount - 1
Set pLayer = pMap.Layer(i)
If TypeOf pLayer Is IFeatureLayer Then
Set pFLayer = pLayer
Set pDS = pFLayer.FeatureClass
Str = Str + pDS.BrowseName + ":" + vbCrLf
Set pLayerExt = pFLayer
For j = 0 To pLayerExt.ExtensionCount - 1
If TypeOf pLayerExt.Extension(j) Is IRouteLayerExtension Then
Set pRtLayerExt = pLayerExt.Extension(j)
Set pName = pRtLayerExt.RouteLocatorName(pLayer)
Set pRtLocator = pName.Open
Set pEnum = pRtLocator.Identify(pEnvelope, "")
pEnum.Reset
If pEnum.Count > 0 Then
pEnum.Next pRtLoc, pFeat
While Not pFeat Is Nothing
If TypeOf pRtLoc Is IRouteMeasurePointLocation Then
Set pRMPointLoc = pRtLoc
Str = Str + " " + pRtLocator.RouteIDFieldName + ": " + CStr(pRtLoc.RouteID) + vbCrLf
Str = Str + " Measure: " + CStr(Round(pRMPointLoc.Measure, 3)) + vbCrLf
Str = Str + vbCrLf
End If
pEnum.Next pRtLoc, pFeat
Wend
Exit For
End If
End If
Next j
End If
Next i
'+++ Display the found route location(s).
MsgBox Str, vbInformation, "Identify Route Locations"
Exit Sub
eh:
MsgBox "An error occurred: " + Err.Description, vbExclamation, "ERROR"
End Sub