Perform the spatial selection 'Share a line segment with' using ArcObjects

Summary

Instructions provided illustrate how to duplicate the functionality of ArcMap's spatial selection 'share a line segment with' through ArcObjects code.

Procedure

1. Start ArcMap.
2. Open the Visual Basic Editor.
   
   
   In ArcMap, select Tools > Macros > Visual Basic Editor.
   
   
3. In the Project Explorer window, expand Project.mxt and select ArcMap Objects > ThisDocument. Right-click and select View Code.
   
   

   Note:
   Code in the Project's ThisDocument code module will only run in the current map document.  If you want to store the code in all map documents open the Normal.mxt ThisDocument code module.

   
   
4. Copy/Paste the following code into the code module.
   
   

   Code:
   Option Explicit
   
   Public Sub SelectPolyAsSharesSegementWith()
   
   Dim pMxDoc As IMxDocument
   Set pMxDoc = ThisDocument
   Dim pMap As IMap
   Set pMap = pMxDoc.FocusMap
   
   ' Union all of the search features into one geometry and strip off
   ' it's boundary for use in the search. Since we are only interested
   ' in shared segments, not areas, the boundary is all that is needed.
   
   ' Get search layer
   Dim pPolygonLyr As IFeatureLayer
   Set pPolygonLyr = pMap.Layer(1)
   Dim pLFeatClass As IFeatureClass
   Set pLFeatClass = pPolygonLyr.FeatureClass
   
   ' Loop through the polygons, simplify them and then
   ' add them to a Geometry Bag.
   Dim pFeatureCursor As IFeatureCursor
   Set pFeatureCursor = pLFeatClass.Search(Nothing, True)
   Dim pFeature As IFeature
   Set pFeature = pFeatureCursor.NextFeature
   Dim pGeometryCollection As IGeometryCollection
   Set pGeometryCollection = New GeometryBag
   Dim pTopologicalOperator2 As ITopologicalOperator2
   
   Do While Not pFeature Is Nothing
       Set pTopologicalOperator2 = pFeature.ShapeCopy
       pTopologicalOperator2.IsKnownSimple = False
       pTopologicalOperator2.Simplify
       pGeometryCollection.AddGeometry pTopologicalOperator2
       Set pFeature = pFeatureCursor.NextFeature
   Loop
   
   ' Union all the polygons
   Dim pTopologicalOperator1 As ITopologicalOperator2
   Set pTopologicalOperator1 = New Polygon
   pTopologicalOperator1.ConstructUnion pGeometryCollection
   
   ' Construct the boundary of the unioned polygons
   Dim pTopologicalOperator3 As ITopologicalOperator2
   Set pTopologicalOperator3 = New Polyline
   Set pTopologicalOperator3 = pTopologicalOperator1.Boundary
   
   ' Use the boundary to find the candidate features
   
   ' Get the target FeatureClass
   Dim pFeatureLayer As IFeatureLayer
   Set pFeatureLayer = pMap.Layer(0)
   Dim pFeatureClass As IFeatureClass
   Set pFeatureClass = pFeatureLayer.FeatureClass
   
   ' Set up a scratch workspace to use for the selection
   Dim pScratchWorkspace As IWorkspace
   Dim pScratchWorkspaceFactory As IScratchWorkspaceFactory
   Set pScratchWorkspaceFactory = New ScratchWorkspaceFactory
   Set pScratchWorkspace = pScratchWorkspaceFactory.DefaultScratchWorkspace
   
   ' Setup the spatial filter
   Dim pSpatialFilter As ISpatialFilter
   Set pSpatialFilter = New SpatialFilter
   With pSpatialFilter
       Set .Geometry = pTopologicalOperator3
       .GeometryField = "SHAPE"
       .SpatialRel = esriSpatialRelIntersects
   End With
   
   ' Perform the search and create a selection set
   Dim pTempSelection As ISelectionSet
   Set pTempSelection = pFeatureClass.Select(pSpatialFilter, esriSelectionTypeIDSet, esriSelectionOptionNormal, pScratchWorkspace)
   
   ' Loop through the features and check to see if they share a segment
   ' with the search geometry. If they don't, remove them from the selection
   ' set.
   
   ' Create a feature cursor to allow us the examine the candidate features
   Dim pTempFeatCur As IFeatureCursor
   pTempSelection.Search Nothing, True, pTempFeatCur
   
   Dim iOIDList(1) As Long
   Dim iOIDListCount As Long
   iOIDListCount = 1
   Dim pGeometry As IPolyline
   Dim pTempFeat As IFeature
   
   ' Fetch the first feature
   Set pTempFeat = pTempFeatCur.NextFeature
   Dim pTempPolyline As IPolyline
   
   ' Check for the one dimentional intersection of the geometries.
   ' If there is no intersection the returned geometry will be empty. If
   ' it is, remove it from the selection set.
       
   Dim pTopologicalOperator4 As ITopologicalOperator2
   Set pTopologicalOperator4 = New Polygon
   
   Do
       iOIDList(0) = pTempFeat.OID
       
       Set pTopologicalOperator4 = pTempFeat.ShapeCopy
   
       pTopologicalOperator4.IsKnownSimple = False
       pTopologicalOperator4.Simplify
       
       Set pTempPolyline = pTopologicalOperator4.Boundary
   
       Set pGeometry = pTopologicalOperator3.Intersect(pTempPolyline, esriGeometry1Dimension)
       If pGeometry.IsEmpty Then
          pTempSelection.RemoveList iOIDListCount, iOIDList(0)
       End If
        
       Set pTempFeat = pTempFeatCur.NextFeature
   Loop Until pTempFeat Is Nothing
   
   ' Set the feature selection
   Dim pFeatureSelection As IFeatureSelection
   Set pFeatureSelection = pFeatureLayer
   Set pFeatureSelection.SelectionSet = pTempSelection
   
   ' Display the selected features.
   Dim pdoc As IMxDocument
   Set pdoc = ThisDocument
   pdoc.ActiveView.Refresh
   
   End Sub

   
   
5. Close the Visual Basic Editor.
6. Run the code.
   
   
   A. Click Tools > Macros > Macros to display the Macros dialog box.
   B. Select a macro and click Run.