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
Angemeldete Mitglieder können Beiträge verfassen, Updates folgen und mehr. Neu hier? Registriere ein kostenloses Konto.
Find useful guides, FAQs, and documents to help you navigate and make the most of Esri Community.