• Multipart polyline to single part lines


    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

  • 相关阅读:
    BOOST库 消息队列 紧急注意事项 what(): boost::interprocess_exception::library_error
    BOOST 环形队列circular_buffer
    Linux ALSA音频库(二) 环境测试+音频合成+语音切换 项目代码分享
    系统编程-进程-先后fork或open一个文件的区别
    实战:单例的析构,为什么可以析构,重复析构等注意事项
    系统编程-进程间通信-无名管道
    4.1 urllib--通过URL打开任意资源--2
    4.1 urllib--通过URL打开任意资源
    第四章 4.1 urllib--通过URL打开任意资源
    3.5 爬虫身份识别与实现网络爬虫技术语言
  • 原文地址:https://www.cnblogs.com/xiexiaokui/p/4829902.html
Copyright © 2020-2023  润新知