How to calibrate routes with points


This VBA code demonstrates how to calibrate a route feature class using calibration points. The point feature class needs to have two fields. The first field identifies which route the point is be used to calibrate. The second field is the route's measure value at that point.
The CalibrateRoutesByDistance method is used in this sample. The CalibrateRoutesByMs option is also available.

How to use

  1. Paste the code into VBA.
  2. Modify the code to match your data paths, etc.
  3. Run the code.
[VBA]
Public Sub CalibrateRoutesByDistance(sAccessWS As String, sRouteFC As String, sPointFC As String, sRouteRIDField As String, _
                                     sOutputRouteFC As String, sPointRIDField As String, sMeasureField As String)
    
    
    '+++ VARIABLES
    '+++ sAccessWS - access workspace (i.e. "\\burt\data\dyndata\pitt.mdb")
    '+++ sRouteFC - route feature class (i.e "routes_hwy")
    '+++ sPointFC - calibration point feature class (i.e "cal_points")
    '+++ sRouteRIDField - route identifier field for the route feature class (i.e "rkey")
    '+++ sOutputRouteFC - name of output route feature class (i.e. "calibrated_routes")
    '+++ sPointRIDField - route identifier field for the point feature class (i.e "rkey")
    '+++ sMeasureField - measure field in the point feature class (i.e "mile")
    
    
    
    
    On Error GoTo eh
    
    '+++ Get the route feature class and the point feature class. We'll assume that they come from
    '+++ the same workspace.
    Dim pWS As IWorkspace
    Dim pWSF As IWorkspaceFactory
    Dim pFWS As IFeatureWorkspace
    Dim pRouteFC As IFeatureClass
    Dim pPointFC As IFeatureClass
    
    Set pWSF = New AccessWorkspaceFactory
    Set pWS = pWSF.OpenFromFile(sAccessWS, 0)
    Set pFWS = pWS
    Set pRouteFC = pFWS.OpenFeatureClass(sRouteFC)
    Set pPointFC = pFWS.OpenFeatureClass(sPointFC)
    
    
    '+++ Create a route locator for the route feature class. This is how we set the route identifier
    '+++ field for the route feature class.
    Dim pRtLocName As IRouteLocatorName
    Dim pRtLoc As IRouteLocator
    Dim pDS As IDataset
    Dim pName As IName
    
    Set pDS = pRouteFC
    Set pName = pDS.FullName
    Set pRtLocName = New RouteMeasureLocatorName
    With pRtLocName
        Set .RouteFeatureClassName = pName
        .RouteIDFieldName = sRouteRIDField
    End With
    Set pName = pRtLocName
    Set pRtLoc = pName.Open
    
    
    '+++ Create an output feature class name object. We'll write to a stand alone feature class in the
    '+++ the same workspace as the inputs
    Dim pOutFCN As IFeatureClassName
    Dim pOutDSN As IDatasetName
    Dim pOutWSN As IWorkspaceName
    Dim sName As String
    
    Set pDS = pWS
    Set pOutWSN = pDS.FullName
    Set pOutFCN = New FeatureClassname
    Set pOutDSN = pOutFCN
    Set pOutDSN.WorkspaceName = pOutWSN
    pOutDSN.Name = sOutputRouteFC 'This name should not already exist
    
    
    '+++ Create a geometry definition for the new feature class. For the most part, we will copy the geometry
    '+++ definition from the input routes. We'll explicitly set the M Domain, however. You should always set an
    '+++ M Domain that is appropriate to your data. What is below is just a sample
    Dim pClone As IClone
    Dim pGDef As IGeometryDef
    Dim pGDefEdit As IGeometryDefEdit
    Dim pSRef As ISpatialReference2
    Dim pFlds As IFields
    Dim pFld As IField
    Dim i As Long
    Set pFlds = pRouteFC.Fields
    i = pFlds.FindField(pRouteFC.ShapeFieldName)
    Set pFld = pFlds.Field(i)
    Set pClone = pFld.GeometryDef
    Set pGDef = pClone.Clone
    Set pSRef = pGDef.SpatialReference
    pSRef.SetMFalseOriginAndUnits -1000, 1000
    
    
    '+++ Set up some parameters for the calibration. Change these to suit your needs.
    Dim lUpdateHow As Long
    Dim bIgnoreGaps As Boolean
    Dim dTolerance As Double
    Dim bAllRoutes As Boolean
    lUpdateHow = 7 'interpolate between and extrapolate before/after calibration points
    bIgnoreGaps = True 'gaps will be ignored for disjointed routes
    dTolerance = 10 'all points within the tolerance will be used to calibrate
    bAllRoutes = True 'routes that were not calibrated will be written to the output feature class
    
    '+++ Create a new RouteMeasureCalibrator object. Note that below, instead of setting the InputFeatureClass
    '+++ property, you can set the InputFeatureSelection property if you want to use a selected set of
    '+++ input points.
    Dim pRouteCalibrator As IRouteMeasureCalibrator
    Dim pErrors As IEnumBSTR
    Set pRouteCalibrator = New RouteMeasureCalibrator
    With pRouteCalibrator
        Set .InputFeatureClass = pPointFC
        .InputMeasureFieldName = sMeasureField 'Name of the measure field in the point feature class
        .InputRouteIDFieldName = sPointRIDField 'Route id field of the point feature class
        Set .RouteLocator = pRtLoc
    End With
    Set pErrors = pRouteCalibrator.CalibrateRoutesByDistance(lUpdateHow, bIgnoreGaps, dTolerance, bAllRoutes, _
                  pOutFCN, pGDef, "", Nothing)
    
    
    '+++ The results of running IRouteMeasureCalibrator::CalibrateRoutesByDistance returns IEnumBSTR, which is a container
    '+++ for a list of error strings indicating why certain points could not be used to calibrate.
    Dim sError As String
    sError = pErrors.Next
    While Not Len(sError) = 0
        Debug.Print sError
        sError = pErrors.Next
    Wend
    
    Exit Sub
eh:
    Dim lNum As Long, sSrc As String, sDesc As String
    lNum = Err.Number
    sSrc = Err.Source
    sDesc = Err.Description
    Err.Raise lNum, sSrc, sDesc
    
End Sub






Additional Requirements
  • ArcEditor at 9.0; ArcView at 9.1 forward