Move points to a line features with matching attributes

NelsonBetancourt — Tue, 21 Jun 2011 13:14:49 GMT

Hi guys, i have some problem here: i have found this piece of code that performs a snapping to lines based in attributes, but this "snap" is just to the End points of those lines. What i need is this same snap matching attributes but along the line, not in the end points of the line features.

This is the code that i have been using, hope anyone can help me.

Thanks

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

topic Move points to a line features with matching attributes in ArcObjects SDK Questions

Move points to a line features with matching attributes