| Products: ArcView: VBA Platforms: WindowsRequires: An Edit Session.Minimum ArcGIS Release: 9.0 |
How to use:
- Paste this macro into VBA.
- Start an edit session with point data (and other data for snapping to).
- Select at least one point feature.
- Set the snapping environment to the desired settings.
- Build the map cache.
- Run this macro.
Option Explicit Public SubBatchSnapping()DimpEditorAsIEditor, pSnapEnvAsISnapEnvironmentDimpMxDocAsIMxDocumentDimpFeatureAsIFeature, pEnumFeatAsIEnumFeatureDimpPoint1AsIPoint, iCountAs Integer, iTotCountAs Integer DimpUIDAs NewUID, pNetFeatAsINetworkFeature'Set the editor and the snap environment variablespUID = "esriEditor.editor"SetpEditor = Application.FindExtensionByCLSID(pUID)SetpSnapEnv = pEditor'Make sure we have selected featuresIfpEditor.SelectionCount = 0ThenMsgBox "You don't have any features selected!!"GoToLeaveSubEnd If'Loop through the selected features snapping only the pointsSetpEnumFeat = pEditor.EditSelection iCount = 0 iTotCount = 0SetpFeature = pEnumFeat.Next pEditor.StartOperationWhile NotpFeatureIs Nothing'Check to make sure selected feature is a point featureiTotCount = iTotCount + 1IfpFeature.Shape.GeometryType = esriGeometryPointThen SetpPoint1 = pFeature.ShapeCopy'Check to see if the location of the point changed (indicating it snapped),'and store the new feature location if it did.IfpSnapEnv.SnapPoint(pPoint1)Then SetpFeature.Shape = pPoint1 iCount = iCount + 1 pFeature.Store'Connect if a simple junctionIfpFeature.FeatureType = esriFTSimpleJunctionThen SetpNetFeat = pFeature pNetFeat.ConnectEnd If End If End If'Get the next featureSetpFeature = pEnumFeat.NextWendpEditor.StopOperation "Bulk move" MsgBoxCStr(iCount) + " of " +CStr(iTotCount) + " moved"'Refresh display if something movedIfiCount > 0Then SetpMxDoc = ThisDocument pMxDoc.ActiveView.RefreshEnd If GoToLeaveSubExit SubLeaveSub:'Clear out the object variablesSetpMxDoc =Nothing SetpEditor =Nothing SetpSnapEnv =Nothing SetpPoint1 =Nothing SetpFeature =Nothing SetpEnumFeat =Nothing SetpNetFeat =Nothing End Sub
