Multipart polyline to single part lines
2015-09-22 18:13
435 查看
Breaking Up Polylines
http://forums.esri.com/Thread.asp?c=93&f=987&t=74554&mc=4#msgid197545
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://forums.esri.com/Thread.asp?c=93&f=987&t=74554&mc=4#msgid197545
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
相关文章推荐
- hihocoder1236(2015长春网赛J题) Scores(bitset && 分块)
- iOS 蓝牙开发资料收集
- ISO 9126质量模型:软件质量模型的6大特性和27个子特性
- C语言——循环缓冲区
- C++的一些心得
- Java parseInt()和parseFloat()的用法
- Java学习之Iterator(迭代器)的一般用法
- org.apache.subversion.javahl.ClientException: svn: E155021: This client is too old to work with the
- 目录扫描
- [Z] Linux 内核同步机制
- Android :关于小数相加出现很多位的 BigDecimal 也会有时不靠谱原因
- 如何取得nginx做反向代理时的真实IP?
- Java很容易出错的一些问题
- Android系统Recovery工作原理之使用update.zip升级过程分析(一)---update.zip包的制作
- php中mysql_real_escape_string+sprintf防止sql注入
- 欧拉函数题集
- Android中ListView(gridview)的item中有button等子点击控件时不能响应点击事件的原因
- java多线程关键字synchronized用法
- 如何验证远程服务器上文件是否存在
- MongoDB学习笔记~数据结构与实体对象不一致时,它会怎么样?