arcengine怎么样根据几个点的坐标绘制出多边形？？-hl3292整理

原文地址：http://blog.163.com/zhug_1970/blog/static/4298305320105109381862/

以下代码可以实现....

Public Sub ConvertPointToPolygon()

On Error GoTo errorHander

    Set pMxDoc = ThisDocument

    Set pMap = pMxDoc.FocusMap

    Set pActiveView = pMap

    Set pFeatureLayer = pMap.Layer(0)

    Set pFeatureClass = pFeatureLayer.FeatureClass

    '创建一个工作区，开始编辑

    Set pDataSet = pFeatureClass

    Set pWorkspaceFactory = New ShapefileWorkspaceFactory

    Set pWorkspaceEdit = pWorkspaceFactory.OpenFromFile(pDataSet.Workspace.PathName, 0)

    pWorkspaceEdit.StartEditOperation

    pWorkspaceEdit.StartEditing True

    Set pMultiLeft = New Multipoint

    Set pMultiRight = New Multipoint

    Set pGonColl = New Polygon

    Set pMultiPoint = New Multipoint

    Set pMultiPointSorted = New Multipoint

    '得到所选择的图形集

    Set pEnumFeature = pMxDoc.FocusMap.FeatureSelection

    Set pFeature = pEnumFeature.Next

    '增加点到MultiPoint

    While Not pFeature Is Nothing

        If pFeature.ShapeCopy.GeometryType = esriGeometryPoint Then

            pMultiPoint.AddPoint pFeature.ShapeCopy

        ElseIf pFeature.ShapeCopy.GeometryType = esriGeometryMultipoint Then

            pMultiPoint.AddPointCollection pFeature.ShapeCopy

        End If

        Set pFeature = pEnumFeature.Next

    Wend

    If pMultiPoint.PointCount < 3 Then

        MsgBox "Select a least 3 points !"

        Exit Sub

End If

    '创建第一个Polygon

    pGonColl.AddPointCollection pMultiPoint

    Set pTopoOp = pGonColl

    '将Polygon是否是Simple设置成未知

    pTopoOp.IsKnownSimple = False

    '经判断，如果不是Simple，则经过以下处理，将其转换为Simple

    If pTopoOp.IsSimple = False and pMultiPoint.PointCount>3 Then

    lFlag = 1

    Set pTopoOp = pMultiPoint

    pTopoOp.IsKnownSimple = False

    pTopoOp.Simplify

    '将Multipoint进行排序

    For i = 0 To pMultiPoint.PointCount - 1

      For j = i + 1 To pMultiPoint.PointCount - 1

        If pMultiPoint.Point(j).x < pMultiPoint.Point(i).x Or pMultiPoint.Point(j).x = _ pMultiPoint.Point(i).x And_ pMultiPoint.Point(j).y < pMultiPoint.Point(i).y Then

            Set pClonei = pMultiPoint.Point(i)

            Set pPointi = pClonei.Clone

            '交换两点

            pMultiPoint.ReplacePoints i, 1, 1, pMultiPoint.Point(j)

            pMultiPoint.ReplacePoints j, 1, 1, pPointi

         End If

      Next

Next

    Set ptMin = New Point

Set ptMax = New Point

    '找出MultiPoint中的最大和最小点

 pMultiPoint.QueryPoint 0, ptMin

    pMultiPoint.QueryPoint pMultiPoint.PointCount - 1, ptMax

    '创建一条线段

    Set pBaseLine = New Line

    pBaseLine.PutCoords ptMin, ptMax

    Set pBaseCurve = pBaseLine

For i = 0 To pMultiPoint.PointCount - 1

      Set pOutpoint = New Point

      pBaseCurve.QueryPointAndDistance esriNoExtension, pMultiPoint.Point(i), False, pOutpoint, _ dDistAlong, dDistFrom, bIsRight

      If bIsRight Then

         pMultiRight.AddPoint pMultiPoint.Point(i)

      Else

         pMultiLeft.AddPoint pMultiPoint.Point(i)

      End If

    Next

    Set pRingColl = New Ring

    '将左边的线添加到Ring

    For i = 0 To pMultiLeft.PointCount - 2

      Set pLine = New Line

      pLine.PutCoords pMultiLeft.Point(i), pMultiLeft.Point(i + 1)

      pRingColl.AddSegment pLine

    Next

    '第一条线

    Set pLine = New Line

    pLine.PutCoords pMultiLeft.Point(pMultiLeft.PointCount - 1), pMultiRight.Point(0)

    pRingColl.AddSegment pLine

    '将右边的先添加到Ring

    For i = (pMultiRight.PointCount - 1) To 1 Step -1

      Set pLine = New Line

      pLine.PutCoords pMultiRight.Point(i), pMultiRight.Point(i - 1)

      pRingColl.AddSegment pLine

    Next

    '最后一条线

    Set pLine = New Line

    pLine.PutCoords pMultiRight.Point(0), pMultiLeft.Point(0)

    pRingColl.AddSegment pLine

    Set pRing = pRingColl

    pRing.Close

    Set pGonColl2 = New Polygon

    pGonColl2.AddGeometry pRing

    End If

    If lFlag = 0 Then

        Set pPolygon = pGonColl

    Else

        Set pPolygon = pGonColl2 'QI

    End If

    '画出Polygon

    Set pFeatureLayer1 = pMap.Layer(1)

    Set pFeatureClass1 = pFeatureLayer1.FeatureClass

    Set pFeature1 = pFeatureClass1.CreateFeature

    '把画的Polygon加到新建的Feature上

    Set pFeature1.Shape = pPolygon

    '保存Feature

    pFeature1.Store

    pMxDoc.ActiveView.Refresh

    '停止编辑

    pWorkspaceEdit.StopEditOperation

    pWorkspaceEdit.StopEditing True

Exit Sub

 

ErrorHander:

    pWorkspaceEdit.AbortEditOperation

    MsgBox Err.Description

End Su

转载于:https://www.cnblogs.com/hl3292/archive/2010/12/06/1897563.html