如何从Polygon创建Polyline

本例要实现的功能是根据一个FeatureLayer中被选择的一个Polygon生成一条Polyline，并把该Polyline做为一个新的Feature保存在一个Polyline类型的FeatureLayer中。

l 要点

通过所选择Polygon创建一个新的Polyline，即要根据Polylgon中的每个Ring生成相应的Path,程序中用到ISegmentCollection接口，将它实例化为Path，利用它的方法AddSegmentCollection实现了这一目的。

l 程序说明

程序中添加了两个图层，第一图层Polylgon型，第二图层Polyline型。因为Polygon型的图层中不能放Polyline型的数据，所以多增加一个Polyline层，以便将通过Polygon来创建的一个新的Polyline显示到上面，使得程序运行结果清晰明了。

函数PolygonToPolyline(ByRef pPolylgon As IPolygon)中,  pSegmentCollectionPath.AddSegmentCollection创建了一个新Ring,其中pSegmentCollectionPath是一个实例化为Ring的ISegmentCollection接口变量。

l 代码

Private Function PolygonToPolyline(ByRef pPolygon As IPolygon) As IGeometryCollection
    Dim pGeometryCollectionPolygon   As IGeometryCollection
    Dim pClone                       As IClone
    Dim pSegmentCollectionPath       As ISegmentCollection
    Dim i                            As Long
    On Error GoTo ErrorHander
    '创建一个新的Polyline geometry.
    Set PolygonToPolyline = New Polyline
    ' 克隆即将要操作的Polygon
    Set pClone = pPolygon
    Set pGeometryCollectionPolygon = pClone.Clone
    '把Polygon的每个Ring创建为一个新的Path,并把Path增加到一个新的Polyline
    For i = 0 To pGeometryCollectionPolygon.GeometryCount - 1
        Set pSegmentCollectionPath = New Path
        pSegmentCollectionPath.AddSegmentCollection pGeometryCollectionPolygon.Geometry(i)
        PolygonToPolyline.AddGeometry pSegmentCollectionPath
    Next i
    Exit Function
ErrorHander:
     MsgBox Err.Description
End Function 

Public Sub CreateNewPolylineFromPolygonGraphic()
    Dim pMxDocument          As IMxDocument
    Dim pEnumFeature         As IEnumFeature
    Dim pFeature0            As IFeature
    Dim pFeatureClass0       As IFeatureClass
    Dim pFeatureLayer0       As IFeatureLayer
    Dim pFeature1            As IFeature
    Dim pFeatureClass1       As IFeatureClass
    Dim pFeatureLayer1       As IFeatureLayer
    Dim pDataSet             As IDataset
    Dim pWorkspaceFactory    As IWorkspaceFactory
    Dim pWorkspaceEdit       As IWorkspaceEdit
    Dim pPolygon             As IPolygon
    Dim pPolyline            As IPolyline
    Dim pMap                 As IMap
    Dim pActiveView          As IActiveView
    On Error GoTo ErrorHander
    Set pActiveView = pMap
    Set pMxDocument = ThisDocument
    Set pMap = pMxDocument.FocusMap
    '得到0，1层的FeatureClass,pFeatureClass0,pFeatureClass1
    Set pFeatureLayer0 = pMxDocument.FocusMap.Layer(0)
    Set pFeatureClass0 = pFeatureLayer0.FeatureClass
    Set pFeatureLayer1 = pMxDocument.FocusMap.Layer(1)
    Set pFeatureClass1 = pFeatureLayer1.FeatureClass
    '创建一个编辑工作区
    Set pDataSet = pFeatureClass1
    Set pWorkspaceFactory = New ShapefileWorkspaceFactory
    Set pWorkspaceEdit = pWorkspaceFactory.OpenFromFile(pDataSet.Workspace.PathName, 0)
    '开始编辑
    pWorkspaceEdit.StartEditOperation
    pWorkspaceEdit.StartEditing True
    '从当前层上得到选择的Feature
    Set pEnumFeature = pMxDocument.FocusMap.FeatureSelection
    Set pFeature0 = pEnumFeature.Next
    '循环Feature
    While Not pFeature0 Is Nothing
        If pFeature0.ShapeCopy.GeometryType = esriGeometryPolygon Then
           'Copy当前层上的一个Featureµ到Polygon
           Set pPolygon = pFeature0.ShapeCopy
           '将Polygon创建为Polyline
           Set pPolyline = PolygonToPolyline(pPolygon)
           '将创建的Polyline,加到Polyline层上，新建的Feature中
           Set pFeature1 = pFeatureClass1.CreateFeature
           Set pFeature1.Shape = pPolyline
           '保存Feature
           pFeature1.Store
        Else
           MsgBox "Must have Polygon in position 0"
           Exit Sub
        End If
        Set pFeature0 = pEnumFeature.Next
    Wend
    pMxDocument.ActiveView.Refresh
    '停止编辑
    pWorkspaceEdit.StopEditOperation
    pWorkspaceEdit.StopEditing True
    Exit Sub
ErrorHander:
pWorkspaceEdit. AbortEditOperation
MsgBox Err.Description
End Sub