Hello, First off I would like to thank anyone who can help me out with this solution. I am running ARCGIS 10.1. I have a point shapefile of transit nodes (TRANSIT_NODES.shp) that I need to join to a line feature (METRO_ROUTES) shapefile. The TRANSIT_NODES.shp has two feilds in called "A" and "B" which represent the beginning and ending node point's IDs and indicate a direction of flow (ie. "A" is the from point, and "B" is then ending point). The line feature class (METRO_ROUTES) has been split at each node and all the points snap to the lines. I need to spatially join the TRANSIT_NODES to the METRO_ROUTE shapefile in order to match attributees to the begining and ending point of each line based on the "A" or "B" IDs. I found this VBA script on earlier forums for ARCMap 9.3:
Private Sub UpdateLines()
' ---- Modify these values ----
Const FROM_POINT_ID_FIELD = "FromPtID"
Const TO_POINT_ID_FIELD = "ToPtID"
' -----------------------------
Dim pMxDoc As IMxDocument
Dim pFtrLyr As IFeatureLayer
Dim pPtFtrCls As IFeatureClass
Dim pPlFtrCls As IFeatureClass
Dim pPlFtrCsr As IFeatureCursor
Dim pPlFtr As IFeature
Dim lFromFldIdx As Long
Dim lToFldIdx As Long
Dim pFtrIdx As IFeatureIndex
Dim pIdxQry As IIndexQuery
Dim pPline As IPolyline
Dim lID As Long
Dim dDis As Double
Set pMxDoc = ThisDocument
' Create a featureindex on the point layer
Set pFtrLyr = pMxDoc.FocusMap.Layer(0)
Set pPtFtrCls = pFtrLyr.FeatureClass
Set pFtrIdx = New FeatureIndex
Set pFtrIdx.FeatureClass = pPtFtrCls
pFtrIdx.Index Nothing, Nothing
Set pIdxQry = pFtrIdx
' Get the field indexes and an update cursor on the line layer
Set pFtrLyr = pMxDoc.FocusMap.Layer(1)
Set pPlFtrCls = pFtrLyr.FeatureClass
lFromFldIdx = pPlFtrCls.FindField(FROM_POINT_ID_FIELD)
lToFldIdx = pPlFtrCls.FindField(TO_POINT_ID_FIELD)
Set pPlFtrCsr = pPlFtrCls.Update(Nothing, False)
' Loop thru the lines and update the endpoint ID fields
Set pPlFtr = pPlFtrCsr.NextFeature
While Not pPlFtr Is Nothing
Set pPline = pPlFtr.Shape
' Get the ID of the From Point
pIdxQry.NearestFeature pPline.FromPoint, lID, dDis
pPlFtr.Value(lFromFldIdx) = lID
' Get the ID of the To Point
pIdxQry.NearestFeature pPline.ToPoint, lID, dDis
pPlFtr.Value(lToFldIdx) = lID
' Upate the line feature
pPlFtrCsr.UpdateFeature pPlFtr
' Get next line feature
Set pPlFtr = pPlFtrCsr.NextFeature
Wend
pPlFtrCsr.Flush
Set pIdxQry = Nothing
Set pFtrIdx = Nothing
MsgBox "Finished Processing Line Layer", vbInformation, ""
End Sub
When I run this macro as is (with no chnages to it), I get an error:
Runtime Error ' -2147220990 (80040202)':
The index pass was not within the valid range.
When I go to debug, it gets hung up on the line:
pPlFtr.Value(lFromFldIdx) = lID
I am a complete novice to vba scripting, so any help in getting this issue resolved would be extremely helpful and much appreciated.
Clinton
Private Sub UpdateLines()
' ---- Modify these values ----
Const FROM_POINT_ID_FIELD = "FromPtID"
Const TO_POINT_ID_FIELD = "ToPtID"
' -----------------------------
Dim pMxDoc As IMxDocument
Dim pFtrLyr As IFeatureLayer
Dim pPtFtrCls As IFeatureClass
Dim pPlFtrCls As IFeatureClass
Dim pPlFtrCsr As IFeatureCursor
Dim pPlFtr As IFeature
Dim lFromFldIdx As Long
Dim lToFldIdx As Long
Dim pFtrIdx As IFeatureIndex
Dim pIdxQry As IIndexQuery
Dim pPline As IPolyline
Dim lID As Long
Dim dDis As Double
Set pMxDoc = ThisDocument
' Create a featureindex on the point layer
Set pFtrLyr = pMxDoc.FocusMap.Layer(0)
Set pPtFtrCls = pFtrLyr.FeatureClass
Set pFtrIdx = New FeatureIndex
Set pFtrIdx.FeatureClass = pPtFtrCls
pFtrIdx.Index Nothing, Nothing
Set pIdxQry = pFtrIdx
' Get the field indexes and an update cursor on the line layer
Set pFtrLyr = pMxDoc.FocusMap.Layer(1)
Set pPlFtrCls = pFtrLyr.FeatureClass
lFromFldIdx = pPlFtrCls.FindField(FROM_POINT_ID_FIELD)
lToFldIdx = pPlFtrCls.FindField(TO_POINT_ID_FIELD)
Set pPlFtrCsr = pPlFtrCls.Update(Nothing, False)
' Loop thru the lines and update the endpoint ID fields
Set pPlFtr = pPlFtrCsr.NextFeature
While Not pPlFtr Is Nothing
Set pPline = pPlFtr.Shape
' Get the ID of the From Point
pIdxQry.NearestFeature pPline.FromPoint, lID, dDis
pPlFtr.Value(lFromFldIdx) = lID
' Get the ID of the To Point
pIdxQry.NearestFeature pPline.ToPoint, lID, dDis
pPlFtr.Value(lToFldIdx) = lID
' Upate the line feature
pPlFtrCsr.UpdateFeature pPlFtr
' Get next line feature
Set pPlFtr = pPlFtrCsr.NextFeature
Wend
pPlFtrCsr.Flush
Set pIdxQry = Nothing
Set pFtrIdx = Nothing
MsgBox "Finished Processing Line Layer", vbInformation, ""
End Sub
When I run this macro as is (with no chnages to it), I get an error:
Runtime Error ' -2147220990 (80040202)':
The index pass was not within the valid range.
When I go to debug, it gets hung up on the line:
pPlFtr.Value(lFromFldIdx) = lID
I am a complete novice to vba scripting, so any help in getting this issue resolved would be extremely helpful and much appreciated.
Clinton