博客
关于我
强烈建议你试试无所不能的chatGPT,快点击我
Multipart polyline to single part lines
阅读量:5972 次
发布时间:2019-06-19

本文共 2623 字,大约阅读时间需要 8 分钟。

Breaking Up Polylines 

 

It appears as though IGeometryCollection is the way to go here, rather than ISegmentCollection. I noticed that the "ISegmentCollection" version created 905 line segments (from 15 polylines). ISegmentCollection created a line for every Single PAIR of vertices - 905 straight, two vertex lines. 

There is no way I could have put this thing together at this point. Thanks for getting the ball rolling. 
Hopefully, this can be useful to other users. Multipart lines can be a huge pain when you don't want them. 

Sub ExplodePolyLines()

'

' From the original by Kirk Kuykendall.

'

Dim pUID As New UID

pUID.Value = "esricore.Editor"

 

Dim pEditor As IEditor

Set pEditor = Application.FindExtensionByCLSID(pUID)

 

If pEditor.EditState <> esriStateEditing Then

MsgBox "Make a shapefile editable."

Exit Sub

End If

 

Dim pEditlayers As IEditLayers

Set pEditlayers = pEditor

 

If pEditlayers.CurrentLayer.FeatureClass.ShapeType <> esriGeometryPolyline Then

Exit Sub

End If

 

Dim pFSel As IFeatureSelection

Set pFSel = pEditlayers.CurrentLayer

 

If pFSel.SelectionSet.Count = 0 Then

MsgBox "Select features to be broken up."

Exit Sub

End If

 

Dim pFCur As IFeatureCursor

pFSel.SelectionSet.Search Nothing, False, pFCur

 

pEditor.StartOperation

Dim pFeat As IFeature

Set pFeat = pFCur.NextFeature

Do Until pFeat Is Nothing

Dim pInGeomColl As IGeometryCollection

''' Dim pInSegColl As ISegmentCollection

''' Set pInSegColl = pFeat.ShapeCopy

Set pInGeomColl = pFeat.ShapeCopy

 

Application.StatusBar.Message(0) = "Exploding " & pFeat.OID

Dim l As Long

''' For l = 0 To pInSegColl.SegmentCount - 1

For l = 0 To pInGeomColl.GeometryCount - 1

''' Dim pOutSegColl As ISegmentCollection

''' Set pOutSegColl = New Polyline

Dim pOutGeomColl As IGeometryCollection

Set pOutGeomColl = New Polyline

''' pOutSegColl.AddSegment pInSegColl.Segment(l)

pOutGeomColl.AddGeometry pInGeomColl.Geometry(l)

Dim pOutFeat As IFeature

Set pOutFeat = pEditlayers.CurrentLayer.FeatureClass.CreateFeature

Dim k As Long

For k = 0 To pOutFeat.Fields.FieldCount - 1

If pOutFeat.Fields.Field(k).Editable Then

If pOutFeat.Fields.Field(k).Type <> esriFieldTypeGeometry Then

pOutFeat.Value(k) = pFeat.Value(k)

End If

End If

Next k

''' Set pOutFeat.Shape = pOutSegColl

Set pOutFeat.Shape = pOutGeomColl

pOutFeat.Store

Next l

pFeat.Delete

Set pFeat = pFCur.NextFeature

Loop

pEditor.StopOperation "Explode"

 

Dim pMxDoc As IMxDocument

Set pMxDoc = pEditor.Parent.Document

Dim pAV As IActiveView

Set pAV = pMxDoc.FocusMap

Dim lCacheID As Long

lCacheID = pAV.ScreenCacheID(esriViewGeoSelection, Nothing)

pAV.ScreenDisplay.Invalidate Nothing, True, lCacheID

MsgBox "Done"

End Sub

转载地址:http://zzzox.baihongyu.com/

你可能感兴趣的文章
Frament填坑
查看>>
Android下 scrollview的滚动停止事件的监听方法
查看>>
数据结构与算法之KMP算法02
查看>>
×××安全协议之IPsec
查看>>
用Unity3D的50个技巧:Unity3D最佳实践
查看>>
记录:C#编程中的字符串
查看>>
NEO从源码分析看NEOVM
查看>>
我的友情链接
查看>>
Btrfs入门(一)
查看>>
java中的匿名内部类总结
查看>>
多线程(一、线程安全案例)
查看>>
mysql之DDL操作--数据库
查看>>
java json格式的转换和读取
查看>>
find的命令的使用和文件名的后缀
查看>>
恢复WORD2010的默认模板2011-05-03
查看>>
Test2 unit2
查看>>
首届中国IT架构大师高峰论坛(十年架构之路汇成一句话!)
查看>>
【Windows编程】系列第三篇:文本字符输出
查看>>
shell脚本逻辑判断,文件目录属性判断,if,case用法
查看>>
教程:一起学习Hystrix--服务(依赖)失败场景的表象
查看>>