Snap Points to Lines Based on Distance and Attributes Code help

[ClintonCooper1]

I found this piece of code through my searches and need a few pointers on how to get this to work:

Private Sub MovePoint()

Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument

'''''''''''''''''''''''''''''''''''''''''''''''
Dim pFLayerA As IFeatureLayer
Set pFLayerA = pMxDoc.FocusMap.Layer(0) 'my point layer

Dim pFClassA As IFeatureClass
Set pFClassA = pFLayerA.FeatureClass

Dim FCursorA As IFeatureCursor
Dim FeatureA As IFeature
'''''''''''''''''''''''''''''''''''''''''''''''''

Dim FCursorB As IFeatureCursor
Dim FeatureB As IFeature

Dim ThePoint As IPoint
Dim TheCurve As ICurve

Dim pFLayerB As IFeatureLayer
Set pFLayerB = pMxDoc.FocusMap.Layer(1) 'my line layer

Dim pfClassB As IFeatureClass
Set pfClassB = pFLayerB.FeatureClass

Dim SpFLayerB As IFeatureSelection
Set SpFLayerB = pMxDoc.FocusMap.Layer(1)

'''''''''''''''''''''''''''''''''''''''''''''''''''

Dim K As String 'K is the Line ID
Dim Y As Integer 'Y is the position of the LN_ID field i.e the line "NOMBRE" field

'Define a query to be use in the cursor to select only the line associated with the point
Dim pfilter As IQueryFilter
Dim strQuery As String


Dim pNearPoint As IPoint
Dim DistOnCurve As Double
Dim NearDist As Double
Dim bRight As Boolean

''''''''''''''''''''''''''''''''''''''''''''''''''''
'Find position of the LN_ID field in the point layer
Y = pFClassA.FindField("NOMBRE")

'Open point cursor
Set FCursorA = pFClassA.Update(Nothing, True)
Set FeatureA = FCursorA.NextFeature

'Loop through all records in point layer
Do Until FeatureA Is Nothing

Set ThePoint = FeatureA.Shape

'Set up the filter for the line cursor
K = FeatureA.Value(Y) 'Find the line id in the point layer
strQuery = "NOMBRE = '" & K & "'"
Set pfilter = New QueryFilter
pfilter.WhereClause = strQuery

'Open line cursor as select the line based of pfilter value
Set FCursorB = pfClassB.Search(pfilter, False)
Set FeatureB = FCursorB.NextFeature
Set TheCurve = FeatureB.Shape
Set pNearPoint = New Point

'Find nearest point on the line to the point
TheCurve.QueryPointAndDistance esriNoExtension, ThePoint, False, _
pNearPoint, DistOnCurve, NearDist, bRight

'Update the old point to the new point
Set FeatureA.Shape = pNearPoint
FCursorA.UpdateFeature FeatureA

'Move to the next record in the point feature
Set FeatureA = FCursorA.NextFeature

Loop

pMxDoc.ActiveView.Refresh

MsgBox "Done"

End Sub



I am a newbie when it comes to running scripts.  I do understand that I need to have the point feature class at the top of my toc and the line feature class second right under it.  But I am not sure what I need to change within the script above to make it work in my mxd.  For example what lines of code do I change to find the fields that need to match?  Thanks in advance!

I am running ARCGIS 10.1 SP1

[ClintonCooper1]

Since this is in VBA, will this script even work in 10.1?


I got it to loop for a few minutes, and the I got an error:

Runtime Error "91":
Oject Variable or With Block Variabel Not Set

When I go to debug it, it takes me to line:

Set TheCurve = FeatureB.Shape

Anyone out there that can help with this?

[RichardFairhurst]

Since this is in VBA, will this script even work in 10.1?


I got it to loop for a few minutes, and the I got an error:

Runtime Error "91":
Oject Variable or With Block Variabel Not Set

When I go to debug it, it takes me to line:

Set TheCurve = FeatureB.Shape

Anyone out there that can help with this?

You should not be able to author this in 10.1 as far as I know, since VBA authoring should not be allowed.  So how are you creating and running this?

In any case, are you sure that your Line ID values are never Null in the points and that every point has a Line ID value that matches an actual line?  If either of these conditions are not met the cursor will set FeatureB to Nothing and the line you mentioned will fail.  Here is your main loop with a test for the assignment of FeatureB and a MsgBox to help you figure out why the queryfilter gets no hit if FeatureB is Nothing.

'Loop through all records in point layer
Do Until FeatureA Is Nothing

  Set ThePoint = FeatureA.Shape

  'Set up the filter for the line cursor
  K = FeatureA.Value(Y) 'Find the line id in the point layer
  strQuery = "NOMBRE = '" & K & "'"
  Set pfilter = New QueryFilter
  pfilter.WhereClause = strQuery

  'Open line cursor as select the line based of pfilter value
  Set FCursorB = pfClassB.Search(pfilter, False)
  Set FeatureB = FCursorB.NextFeature

  'Verify that a feature was found
  If Not FeatureB Is Nothing Then
    Set TheCurve = FeatureB.Shape
    Set pNearPoint = New Point

    'Find nearest point on the line to the point
    TheCurve.QueryPointAndDistance esriNoExtension, ThePoint, False, _
    pNearPoint, DistOnCurve, NearDist, bRight

    'Update the old point to the new point
    Set FeatureA.Shape = pNearPoint
    FCursorA.UpdateFeature FeatureA
  Else
    MsgBox("No Line Feature Found.  Where Clause was: " & strQuery
  End If

  'Move to the next record in the point feature
  Set FeatureA = FCursorA.NextFeature

Loop

[ClintonCooper1]

Thanks for the help.  I enabled VBA by doing a sperate download for vba and then getting an authorization file from ESRI to run it.  I have made sure that all line_ids match the point_ids and that there are no nulls.  I took a smaller section of my data and it did make it through.  However I got an unexpected issue. 


It did move and snap my points to endpoints, but it moved them not to the closet line endpoint that it matched, but it moved them all to one endpoint of one line.

So my question then is this, can I modify this code to move and snap the points to the nearest line with that same attribute?  If so, what would that new code  be?

Here is the code I used, and I have attached my trial data

Sub MovePoint()

Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument

'''''''''''''''''''''''''''''''''''''''''''''''
Dim pFLayerA As IFeatureLayer
Set pFLayerA = pMxDoc.FocusMap.Layer(0) 'my point layer

Dim pFClassA As IFeatureClass
Set pFClassA = pFLayerA.FeatureClass

Dim FCursorA As IFeatureCursor
Dim FeatureA As IFeature
'''''''''''''''''''''''''''''''''''''''''''''''''

Dim FCursorB As IFeatureCursor
Dim FeatureB As IFeature

Dim ThePoint As IPoint
Dim TheCurve As ICurve

Dim pFLayerB As IFeatureLayer
Set pFLayerB = pMxDoc.FocusMap.Layer(1) 'my line layer

Dim pfClassB As IFeatureClass
Set pfClassB = pFLayerB.FeatureClass

Dim SpFLayerB As IFeatureSelection
Set SpFLayerB = pMxDoc.FocusMap.Layer(1)

'''''''''''''''''''''''''''''''''''''''''''''''''''

Dim K As String  'K is the Line ID
Dim Y As Integer  'Y is the position of the LN_ID field i.e the line id field

'Define a query to be use in the cursor to select only the line associated with the point
Dim pfilter As IQueryFilter
Dim strQuery As String


Dim pNearPoint As IPoint
Dim DistOnCurve As Double
Dim NearDist As Double
Dim bRight As Boolean

''''''''''''''''''''''''''''''''''''''''''''''''''''
'Find position of the LN_ID field in the point layer
Y = pFClassA.FindField("RTENAME")

'Open point cursor
Set FCursorA = pFClassA.Update(Nothing, True)
Set FeatureA = FCursorA.NextFeature

'Loop through all records in point layer
Do Until FeatureA Is Nothing

    Set ThePoint = FeatureA.Shape
    
    'Set up the filter for the line cursor
    K = FeatureA.Value(Y) 'Find the line id in the point layer
    strQuery = "RTENAME = '" & K & "'"
    Set pfilter = New QueryFilter
    pfilter.WhereClause = strQuery
    
    'Open line cursor as select the line based of pfilter value
    Set FCursorB = pfClassB.Search(pfilter, False)
    Set FeatureB = FCursorB.NextFeature
    Set TheCurve = FeatureB.Shape
    Set pNearPoint = New Point
       
    'Find nearest point on the line to the point
    TheCurve.QueryPointAndDistance esriNoExtension, ThePoint, False, _
    pNearPoint, DistOnCurve, NearDist, bRight
                      
    'Update the old point to the new point
    Set FeatureA.Shape = pNearPoint
    FCursorA.UpdateFeature FeatureA
    
    'Move to the next record in the point feature
    Set FeatureA = FCursorA.NextFeature

Loop

pMxDoc.ActiveView.Refresh

MsgBox "Done"


End Sub

[T__WayneWhitley]

Clinton, I haven't confirmed this - you'll need to follow up testing.... but think I may have traced the most logical source of your error.

Again, test to confirm, but I suspect there is something wrong with your 'pfilter' parameter in the cursor.  What clued me in is that pfilter is being used twice - in the outer loop for setting the search cursor on points, and again in the inner loop to set another search cursor on the lines (i.e., to limit or 'reselect' line candidates to snap points to --- the point of failure, as you said, is that points are not being snapped to the proper line candidates).

What I'd check then is Y -- field vals are 'looked up' by index, or position in the table...the weakest point this operation fails is that the expected field is in a different position in the line feature class.....so no actual selection is being made and the 1st line in the fc is being used for snapping.

So, the culprit I believe is this line...using the field position in pFClassA really has no bearing on the position in pFClassB:
Y = pFClassA.FindField("RTENAME")

I'm probably not going to test this, but will post a corrected code sub in a minute...if you (or someone else that may be reading this) is making these corrections before I post again, I would set up different pfilter params to feed into the search cursors (or you could reorganize your table, but rather you should fix the code to prevent this loophole).

Hope that helps.

Enjoy,
Wayne


EDIT:  Actually, I was curious and ran your code after reconsidering how the pfilter above was formed, and since you have the same field and looking up the same val in both tables, then the pfilter doesn't need 'refreshing', so to speak.

Seems to run for me, except it snaps to to the line, not necessarily to one of the endpoints or for that matter, the proper street -- so I take it, you are really asking for refinement of the snapping?  I noticed you have duplicate values in both tables - this will not work well, since the 1st feature in the street query selection will be used in snapping [regardless of spatial position].)

[ClintonCooper1]

Wayne,  So would it work best to do a dissolve on RTENAME for the lines to create a shapefile with only one unique RTENAME, and then run the script?  I think I can go back and then resplit the lines at intersections.  However I may end up losing my address fields then, which would not work.  Thinking out loud though, I could just use this dummy dissolve line file to get the lines snapped, but keep the original file and join back to that.  

Clinton

[T__WayneWhitley · Accepted solution]

No I don't think this is your only option, certainly not the best option I wouldn't think... my thoughts are that maybe tighten how the queries are being made if you can more accurately pinpoint how the points and lines are being targeted for snapping.  As it stands, it runs a little wild, if you'll pardon the figure of speech.

Earlier, I think I described it as 1 loop for selecting the street 'candidates' nested inside the other loop selecting (or iterating over) the points.  What I referred to as the 'inner loop' to select the street candidate isn't really a loop per se, but more of a 'set' to gain access to the 1st feature in a selection...which is a problem, since again these are multiple features in no particular order satisfying the query, correct?

Not sure where to go from here, let me think - could be if you cannot make your field values better 'correlated' in a way that the queries are more precise, you may be better off with some sort of 'bulk snap'...I'll look into that if I have time.  Meanwhile someone else may have a better suggestion.

Also, extremely curious about the method, QueryPointAndDistance.  I think that is on ICurve... yes, "Dim TheCurve As ICurve".
So it may help to better understand all the parameters entered for that method from this line (below) in your code - maybe some 'adjustments' will give you better results:

TheCurve.QueryPointAndDistance esriNoExtension, ThePoint, False, _     pNearPoint, DistOnCurve, NearDist, bRight

This 'exercise' actually helps me with some later VB.NET - and so forth add-ins, etc., understanding ArcObjects better.  If I come across any tools or changes in applying the method above, I'll post it.

-Wayne