Solved! Go to Solution.
TheCurve.QueryPointAndDistance esriNoExtension, ThePoint, False, _ pNearPoint, DistOnCurve, NearDist, bRight
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?
'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
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
TheCurve.QueryPointAndDistance esriNoExtension, ThePoint, False, _ pNearPoint, DistOnCurve, NearDist, bRight