Batch Snapping of Selected Points


When executed, this code will snap the points found in the selected set of features based on the current snapping environment. If the features being snapped are simple junction features the Connect command will also be run to insure junctions are included in the network. Be sure to build the edit cache before executing the macro.

How to use:
  1. Paste this macro into VBA.
  2. Start an edit session with point data (and other data for snapping to).
  3. Select at least one point feature.
  4. Set the snapping environment to the desired settings.
  5. Build the edit cache.
  6. Run this macro.
Option Explicit

Public Sub BatchSnapping()
  Dim pEditor As IEditor, pSnapEnv As ISnapEnvironment
  Dim pMxDoc As IMxDocument
  Dim pFeature As IFeature, pEnumFeat As IEnumFeature
  Dim pPoint1 As IPoint, iCount As Integer, iTotCount As Integer
  Dim pUID As New UID, pNetFeat As INetworkFeature
  'Set the editor and the snap environment variables
  pUID = "esricore.editor"
  Set pEditor = Application.FindExtensionByCLSID(pUID)
  Set pSnapEnv = pEditor
  'Make sure we have selected features
  If pEditor.SelectionCount = 0 Then
    MsgBox "You don't have any features selected!!"
    GoTo LeaveSub
  End If
  'Loop through the selected features snapping only the points
  Set pEnumFeat = pEditor.EditSelection
  iCount = 0
  iTotCount = 0
  Set pFeature = pEnumFeat.Next
  While Not pFeature Is Nothing
    'Check to make sure selected feature is a point feature
    iTotCount = iTotCount + 1
    If pFeature.Shape.GeometryType = esriGeometryPoint Then
      Set pPoint1 = pFeature.ShapeCopy
      'Check to see if the location of the point changed (indicating it snapped),
      'and store the new feature location if it did.
      If pSnapEnv.SnapPoint(pPoint1) Then
        Set pFeature.Shape = pPoint1
        iCount = iCount + 1
        'Connect if a simple junction
        If pFeature.FeatureType = esriFTSimpleJunction Then
           Set pNetFeat = pFeature
        End If
      End If
    End If
    'Get the next feature
    Set pFeature = pEnumFeat.Next
  pEditor.StopOperation "Bulk move"
  MsgBox CStr(iCount) + " of " + CStr(iTotCount) + " moved"
  'Refresh display if something moved
  If iCount > 0 Then
    Set pMxDoc = ThisDocument
  End If
  GoTo LeaveSub

  Exit Sub
  'Clear out the object variables
  Set pMxDoc = Nothing
  Set pEditor = Nothing
  Set pSnapEnv = Nothing
  Set pPoint1 = Nothing
  Set pFeature = Nothing
  Set pEnumFeat = Nothing
  Set pNetFeat = Nothing
End Sub