This ArcMap Field Calculator script will update the SHAPE geometry field in an ArcGIS polylineM feature class to reflect new m coordinate values from a given set of calibration points (usually milepost locations). Use within an edit session and checking the result with the Sketch Properties tool is highly recommended.
TO USE:
open the attribute table for the route feature class, select an individual route.
Right click on the SHAPE field or hit CTRL + SHIFT + F to open the field calculator.
In the field calculator, check the Advanced Option and paste the script below in the Pre-Logic VBS Script Code text box.
Make sure that the 3 script parameters are set, These can be found by searching for SET THESE in the code
layer index number for the calibration point feature class
name of the field containing the calibration values
query string to restrict the calibration point set to just the given route
Type the word pMSegmentation2 into the field calculator's bottom text box and hit OK
'This script will employ a feature layer of calibration points 'to refine an existing, end-point calibrated route
Dim routeLayerIndex 'position in TOC Dim routeEndPointLayerIndex 'position in TOC Dim routePointIntCalibrationLayerIndex 'position in TOC
Dim routePointIntCalibrationLayerFieldName As String Dim routePointIntCalibrationLayerQueryString As String
Dim pMxDoc As IMxDocument Dim pMap As IMap Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap
Dim pMSegmentation2 As IMSegmentation2 Dim pRoutePointCollection As IPointCollection Dim pIEnumSplitPoint As IEnumSplitPoint
'Dim rtLayer As IFeatureLayer 'Dim rtFC As IFeatureClass 'Dim rtFeature As IFeature 'Set rtLayer = pMap.Layer(routeLayerIndex) 'Set rtFC = rtLayer.FeatureClass 'Set rtFeature = [Shape] Set pMSegmentation2 = [Shape]
Set pRoutePointCollection = [Shape]
Dim pIntPtFeatureLayer As IFeatureLayer Dim pIntPtFC As IFeatureClass Dim pIntPtFeatureCursor As IFeatureCursor Dim pQF As IQueryFilter Dim pIntPtFeature As IFeature Dim pCalibratePointCollection As IPointCollection Dim pCalibratePointCollectionMAware As IMAware Dim pCalibratePoint As IPoint Dim pCalibratePointMAware As IMAware Dim mCoordFieldIndex As Long Dim pEnumVertex As IEnumVertex
Set pIntPtFeatureLayer = pMap.Layer(routePointIntCalibrationLayerIndex) Set pIntPtFC = pIntPtFeatureLayer.FeatureClass Set pQF = New QueryFilter pQF.WhereClause = routePointIntCalibrationLayerQueryString mCoordFieldIndex = pIntPtFeatureLayer.FeatureClass.FindField(routePointIntCalibrationLayerFieldName)
Dim pTableSort As ITableSort Set pTableSort = New TableSort
Set pTableSort.Table = pIntPtFC pTableSort.Fields = "LABEL,REF_VALUE" Set pTableSort.QueryFilter = pQF pTableSort.Sort Nothing
Set pIntPtFeatureCursor = pTableSort.Rows Set pIntPtFeature = pIntPtFeatureCursor.NextFeature Set pCalibratePointCollection = New Multipoint Set pCalibratePointMAware = pCalibratePointCollection pCalibratePointMAware.MAware = True
Do Until pIntPtFeature Is Nothing
Set pCalibratePoint = pIntPtFeature.ShapeCopy Set pCalibratePointMAware = pCalibratePoint pCalibratePointMAware.MAware = True pCalibratePoint.M = pIntPtFeature.value(mCoordFieldIndex) pCalibratePointCollection.AddPoint pCalibratePoint
Set pIntPtFeature = pIntPtFeatureCursor.NextFeature
