如何将选中的点集转换成Polygon

本例要实现的功能是根据一个FeatureLayer中被选择一个或多个MultiPoint，生成多个Point并把这些新生成的Point保存在一个Point类型的Feature Layer上。

l 要点

本例将选择的Multipoints上的每个点都生成一个对应得Point，并用一个接口IPointCollection的变量来接收。利用IPointCollection的方法point(index),取出新生成的每个点,用来创建Point类型的Feature。

l 程序说明

本例要求在ArcMap中添加两个层，最上面的是层Ｍultipoint，下面是层wind。根据循环得到选择的每个Ｍultipoint的每个点，为wind层生成新的Feature并保存

l 代码

Sub convertMultipointToPoints()
    Dim pMxDocument         As IMxDocument
    Dim pMap                As IMap
    Dim pActiveView         As IActiveView
    Dim pEnumFeature        As IEnumFeature
    Dim pFeature0           As IFeature
    Dim pFeatureLayer0      As IFeatureLayer
    Dim pFeatureClass0      As IFeatureClass
    Dim pFeature1           As IFeature
    Dim pFeatureLayer1      As IFeatureLayer
    Dim pFeatureClass1      As IFeatureClass
    Dim pPointCollection    As IPointCollection
    Dim pDataSet            As IDataset
    Dim pWorkspaceFactory   As IWorkspaceFactory
    Dim pWorkspaceEdit      As IWorkspaceEdit
    Dim lPointIndex         As Long
    Dim lPointFieldIndex    As Long 
    On Error GoTo ErrorHanlder
    '得到当前层
    Set pMxDocument = ThisDocument
    Set pMap = pMxDocument.FocusMap
    Set pActiveView = pMap
    '得到0层和1层的FeatureClass
    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
    If pFeature0 Is Nothing Then
        MsgBox "Must have Select in Position 0"
        Exit Sub
    End If
'循环,通过每个MultiPoint,在１图层上，生成以每个点为特征的Points
    While Not pFeature0 Is Nothing
        If pFeature0.ShapeCopy.GeometryType = esriGeometryMultipoint Then
           Set pPointCollection = pFeature0.ShapeCopy
                For nPointIndex = 0 To pPointCollection.PointCount - 1
            　　Set pFeature1 = pFeatureClass1.CreateFeature
                '在pFeature1上生成Point
                Set pFeature1.Shape = pPointCollection.Point(nPointIndex)
                '如果两Feature的FieldCount相同，赋每个Field的值，ID,
                'TypeGeometry的Field除外
                If pFeature1.Fields.FieldCount = pFeature0.Fields.FieldCount Then
                For lPointFieldIndex = 0 To pFeature1.Fields.FieldCount - 1
                    If Not pFeature1.Fields.Field(lPointFieldIndex).Type = _      esriFieldTypeGeometry And   Not pFeature1.Fields. _
Field(lPointFieldIndex).Type = esriFieldTypeOID Then
                        pFeature1.Value(lPointFieldIndex) = _
pFeature0.Value(lPointFieldIndex)
                    End If
                Next
                End If
                '保存Feature
                pFeature1.Store
                Next
        Else
           MsgBox "Must have Multipoint in position 0"
           Exit Sub
        End If
        Set pFeature0 = pEnumFeature.Next
    Wend
    '停止编辑
    pWorkspaceEdit.StopEditOperation
    pWorkspaceEdit.StopEditing True
    Exit Sub
ErrorHanlder:
pWorkspaceEdit. AbortEditOperation
    MsgBox Err.Description
End Sub