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
- Paste the code into VBA.
- Modify the code to match your data paths, etc.
- Run the code.
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