如何将选中的点集转换成Polygon
本例要实现的功能是根据选中的Points创建一个Polygon，并且保存到Polygon类型的FeatureLayer中，要求被选择的Points最少为3个。
l 要点
根据选择的点创建一个Polygon，首先要判断生成的Polygon是否是Simple,这里用到接口ITopologicalOperator2的属性IsSimple。如果不是,则要对做Polygon排序等处理。此外还用到了接口IPointCollection的方法ReplacePoints，进行点的交换。将排好序的点，按顺序创建Segment，运用实例化为Ring的ISegmentCollection接口方法AddSegment增加Segment。实例化为Polygon的IGeometryCollection接口方法AddGeometry增加Ring。这样，通过上面的方法便可以创建Polygon。
l 程序说明
根据接口ITopologicalOperator2.IsSimple属性判断Polygon是否Simple。如果返回为False，就对Polygon上的点进行排序等处理，排好序后，找出X方向上值最大和最小的点，由这两点创建一条直线，将所有点分成在直线左边和右边两部分。
l 代码
| Public Sub ConvertPointToPolygon() Dim pMxDoc As IMxDocument Dim pMap As IMap Dim pEnumFeature As IEnumFeature Dim pMultiPoint As IPointCollection Dim pMultiPointSorted As IPointCollection Dim pFeature As IFeature Dim pPointi As IPoint Dim pTopoOp As ITopologicalOperator2 Dim pLine As ILine Dim pGonColl As IPointCollection Dim pClonei As IClone Dim ptMin As IPoint Dim ptMax As IPoint Dim pBaseLine As ILine Dim pBaseCurve As ICurve Dim pOutpoint As IPoint Dim pMultiRight As IPointCollection Dim pMultiLeft As IPointCollection Dim pGonColl2 As IGeometryCollection Dim pPolygon As IPolygon Dim pRing As IRing Dim pFeatureClass As IFeatureClass Dim pFeatureLayer 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 pRingColl As ISegmentCollection Dim dDistAlong As Double Dim dDistFrom As Double Dim bIsRight As Boolean Dim i As Long Dim j As Long Dim lFlag As Long 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 Sub |
转载自：https://blog.csdn.net/swfcsunboy/article/details/2358738
