How to find a point location along a route


This VBA code demonstrates how to find a point location along a given route feature. In this example a point 565.5 units along route 1 is found and the located point is drawn on the screen.

How to use

  1. Add a route (PolyLineM) layer to ArcMap called 'roads_route_hwy' (or change the code accordingly).
  2. Paste the code into VBA.
  3. Run the code.
[VBA]
Public Sub FindPointRouteLocation()
    
    '+++ VBA code that shows how to find a point location along a route
    
    On Error GoTo eh
    
    Dim pMxDoc As IMxDocument
    Dim pMap As IMap
    Set pMxDoc = ThisDocument
    Set pMap = pMxDoc.FocusMap
    
    '+++ Get the route feature class. It is called 'roads_route_hwy'.
    Dim pLayer As ILayer
    Dim pFLayer As IFeatureLayer
    Dim pRouteFc As IFeatureClass
    Dim i As Long
    For i = 0 To pMap.LayerCount - 1
        Set pLayer = pMap.Layer(i)
        If LCase(pLayer.Name) = "roads_route_hwy" Then
            If TypeOf pLayer Is IFeatureLayer Then
                Set pFLayer = pLayer
                Set pRouteFc = pFLayer.FeatureClass
                Exit For
            End If
        End If
    Next i
    If pRouteFc Is Nothing Then
        MsgBox "Could not find the route feature class", vbExclamation, "FindPointRouteLocation"
        Exit Sub
    End If
    
    '+++ Create a route locator. This is the object that knows how to find
    '+++ locations along a route.
    Dim pName As IName
    Dim pDS As IDataset
    Dim pRtLocName As IRouteLocatorName
    Dim pRtLoc As IRouteLocator
    
    Set pDS = pRouteFc '+++ A PolyLineM feature class
    Set pName = pDS.FullName
    Set pRtLocName = New RouteMeasureLocatorName
    With pRtLocName
        Set .RouteFeatureClassName = pName
        .RouteIDFieldName = "rkey"
        .RouteIDIsUnique = True
        .RouteMeasureUnit = esriMeters
        .RouteWhereClause = ""
    End With
    Set pName = pRtLocName
    Set pRtLoc = pName.Open
    
    '+++ Create a route location
    Dim pRouteLoc As IRouteLocation
    Dim pRMPointLoc As IRouteMeasurePointLocation
    Set pRouteLoc = New RouteMeasurePointLocation
    With pRouteLoc
        .MeasureUnit = esriMeters
        .RouteID = 1 '+++ the route key
        .LateralOffset = 0
    End With
    Set pRMPointLoc = pRouteLoc
    pRMPointLoc.Measure = 565.5
    
    '+++ Locate the point (it's actually a MultiPoint)
    Dim pGeom As IGeometry
    Dim LocError As esriLocatingError
    pRtLoc.Locate pRMPointLoc, pGeom, LocError
    
    '+++ Draw the Multipoint as a graphic on the screen
    If Not pGeom Is Nothing And Not pGeom.IsEmpty Then
        Dim pGCont As IGraphicsContainer
        Dim pGraphicsLayer As IGraphicsLayer
        Dim pMElement As IMarkerElement
        Dim pElement As IElement
        Dim pPC As IPointCollection
        Dim pPt As IPoint
        Dim pActive As IActiveView
        Set pGraphicsLayer = pMap.BasicGraphicsLayer
        Set pGCont = pGraphicsLayer
        Set pActive = pMxDoc.ActiveView
        Set pPC = pGeom
        For i = 0 To pPC.PointCount - 1
            Set pPt = pPC.Point(i)
            Set pMElement = New MarkerElement
            Set pElement = pMElement
            pMElement.Symbol = New SimpleMarkerSymbol
            pElement.Geometry = pPt
            pGCont.AddElement pElement, 0
        Next i
        pActive.Refresh
    Else
        MsgBox "Point not found", vbExclamation, "FindPointRouteLocation"
        Exit Sub
    End If
    Exit Sub
    
eh:
    Dim lNum As Long, sDesc As String, sSrc As String
    lNum = Err.Number
    sDesc = Err.Description
    sSrc = Err.Source
    Err.Raise lNum, sSrc, sDesc
End Sub






Additional Requirements
  • ArcEditor at 9.0; ArcView at 9.1 forward