如何从Polyline创建Polygon

 

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

l 要点

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

l 程序说明

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

函数PolylineToPolygon(ByRef pPolyline As IPolyline)中,  通过pSegs_Ring.AddSegmentCollection，创建了一个新Ring,其中pSegs_Ring是一个实例化为Ring的ISegmentCollection接口变量。

l 代码

Private Function PolylineToPolygon(ByRef pPolyline As IPolyline) As IGeometryCollection
    Dim pGeoms_Polyline              As IGeometryCollection
    Dim pClone                       As IClone
    Dim pSegs_Ring                   As ISegmentCollection
    Dim pPolygon                     As IPolygon
    Dim i                            As Long
    On Error Goto ErrorHander
    '创建一个新的Polygon geometry.
    Set PolylineToPolygon = New Polyline
    '克隆即将要操作的Polyline
    Set pClone = pPolyline
    Set pGeoms_Polyline = pClone.Clone
    '通过Polyline的每个Path创建为一个新的Ring,并把Ring增加到一个新的Polygon
    For i = 0 To pGeoms_Polyline.GeometryCount - 1
        Set pSegs_Ring = New Ring
        pSegs_Ring.AddSegmentCollection pGeoms_Polyline.Geometry(i)
        PolylineToPolygon.AddGeometry pSegs_Ring
    Next I
'生成的Polygon旋转的顺序可能不正确,为确保正确调用SimplifyPreserveFromTo
    Set pPolygon = PolylineToPolygon
    pPolygon.SimplifyPreserveFromTo
    Exit Function
ErrorHander:
    MsgBox Err.Description
End Function 

Public Sub CreateNewPolygonFromPolylineGraphic()
    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 pMxDocument = ThisDocument    
    '得到当前层
    Set pMap = pMxDocument.FocusMap
    Set pActiveView = pMap
    '得到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 pPolyline = pFeature0.ShapeCopy
           ‘将Polyline创建为Polygon
           Set pPolygon = PolygonToPolyline(pPolyline)
           '将创建的Polygon,加到Polygon层上，新建的Feature中
           Set pFeature1 = pFeatureClass1.CreateFeature
           Set pFeature1.Shape = pPolygon
           '保存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