別のアプローチは、MAPトポロジを使用することです。ぶら下がっているエッジを特定するVBAコードを少し叩きました。ネットワークの予期された端ではなく、ネットワーク内にぶら下がっているエッジがある場合は、切断が必要です。
このコードは、VBAがインストールされ、編集モードになっていて、ポリラインレイヤーをマップトポロジに追加していることに依存しています。
Public Sub SelectDanglingPolylines()
' Description: Takes a polyline dataset and select all dangling polylines.
'
' Requirements: You need to be in edit mode and have added the layer to a MAP TOPOLOGY,
' also polyline layer must be first in TOC.
'
' Limitations: Large datasets take a long time to build the cache and may even fail.
'
' Author: Duncan Hornby
' Created: 11/12/2011
'
' Get map and then first layer, must be of polyline type
Dim pMXDocument As IMxDocument
Set pMXDocument = ThisDocument
Dim pMap As IMap
Set pMap = pMXDocument.FocusMap
Dim pLayer As ILayer
Set pLayer = pMap.Layer(0)
Dim pFeatureLayer As IFeatureLayer
Set pFeatureLayer = pLayer
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = pFeatureLayer.FeatureClass
If pFeatureClass.ShapeType <> esriGeometryPolyline Then
MsgBox "This code works only with polylines!", vbExclamation, "Wrong data type at layer 0"
Exit Sub
End If
' Get editor and topology extension
Dim pEditor As IEditor
Dim pID As New UID
Dim pTopologyExtension As ITopologyExtension
Dim pTEID As New UID
pID = "esriEditor.editor"
Set pEditor = Application.FindExtensionByCLSID(pID)
pTEID = "esriEditorExt.TopologyExtension"
Set pTopologyExtension = Application.FindExtensionByCLSID(pTEID)
If pTopologyExtension.CurrentTopology Is Nothing Then Exit Sub
' Get a MAP topology not a geodatabase topology
Dim pMapTopology As IMapTopology
If TypeOf pTopologyExtension.CurrentTopology Is IMapTopology Then
Set pMapTopology = pTopologyExtension.MapTopology
Else
' Not a Map Topology
Exit Sub
End If
' This is the colection that FID are added to
Dim aColl As New Collection
' Build cache
Application.StatusBar.Message(0) = "Building MAP TOPOLOGY cache, this can take a long time on large datasets..."
DoEvents
Dim pGeoDataset As IGeoDataset
Set pGeoDataset = pFeatureClass
Dim pEnvelope As IEnvelope
Set pEnvelope = pGeoDataset.Extent
pMapTopology.Cache.Build pEnvelope, False
' Identify dangling nodes and add polyline FID to collection
Application.StatusBar.Message(0) = "Identifying dangling nodes..."
DoEvents
Dim pEnumTopologyParent As IEnumTopologyParent
Dim pTopologyNode As ITopologyNode
Dim pEnumTopologyNode As IEnumTopologyNode
Set pEnumTopologyNode = pMapTopology.Cache.Nodes
pEnumTopologyNode.Reset
Set pTopologyNode = pEnumTopologyNode.Next
While Not pTopologyNode Is Nothing
If pTopologyNode.Degree = 1 Then
' As this has 1 degree it has only 1 parent polyline
Set pEnumTopologyParent = pTopologyNode.Parents
pEnumTopologyParent.Reset
aColl.Add (pEnumTopologyParent.Next.m_FID) 'Adds polyline FID to collection
End If
Set pTopologyNode = pEnumTopologyNode.Next
Wend
' Use collection to select polylines
Application.StatusBar.Message(0) = "Selecting polylines..."
DoEvents
Dim pFeatureSelection As IFeatureSelection
Set pFeatureSelection = pFeatureLayer
Dim X As Variant
For Each X In aColl
pFeatureSelection.SelectionSet.Add CLng(X)
Next
pMXDocument.ActiveView.PartialRefresh esriViewGeoSelection, Nothing, pEnvelope
Application.StatusBar.Message(0) = ""
DoEvents
End Sub