<P>Public Sub ConvertPointToPolygon()<BR>    Dim pMxDoc              As IMxDocument<BR>    Dim pMap                As IMap<BR>    Dim pEnumFeature        As IEnumFeature<BR>    Dim pMultiPoint         As IPointCollection<BR>    Dim pMultiPointSorted   As IPointCollection<BR>    Dim pFeature            As IFeature<BR>    Dim pPointi             As IPoint<BR>    Dim pTopoOp             As ITopologicalOperator2<BR>    Dim pLine               As ILine<BR>    Dim pGonColl            As IPointCollection<BR>    Dim pClonei             As IClone<BR>    Dim ptMin               As IPoint<BR>    Dim ptMax               As IPoint<BR>    Dim pBaseLine           As ILine<BR>    Dim pBaseCurve          As ICurve<BR>    Dim pOutpoint           As IPoint<BR>    Dim pMultiRight         As IPointCollection<BR>    Dim pMultiLeft          As IPointCollection<BR>    Dim pGonColl2           As IGeometryCollection<BR>    Dim pPolygon            As IPolygon<BR>    Dim pRing               As IRing<BR>    Dim pFeatureClass       As IFeatureClass<BR>    Dim pFeatureLayer       As IFeatureLayer<BR>    Dim pFeature1           As IFeature<BR>    Dim pFeatureClass1      As IFeatureClass<BR>    Dim pFeatureLayer1      As IFeatureLayer<BR>    Dim pDataSet            As IDataset<BR>    Dim pWorkspaceFactory   As IWorkspaceFactory<BR>    Dim pWorkspaceEdit      As IWorkspaceEdit<BR>Dim pRingColl          As ISegmentCollection<BR>    Dim dDistAlong          As Double<BR>    Dim dDistFrom           As Double<BR>Dim bIsRight            As Boolean<BR>    Dim i                   As Long<BR>Dim j                   As Long<BR>    Dim lFlag               As Long<BR>On Error GoTo ErrorHander<BR>    Set pMxDoc = ThisDocument<BR>    Set pMap = pMxDoc.FocusMap<BR>    Set pActiveView = pMap<BR>    Set pFeatureLayer = pMap.Layer(0)<BR>    Set pFeatureClass = pFeatureLayer.FeatureClass<BR>    '创建一个工作区，开始编辑<BR>    Set pDataSet = pFeatureClass<BR>    Set pWorkspaceFactory = New ShapefileWorkspaceFactory<BR>    Set pWorkspaceEdit = pWorkspaceFactory.OpenFromFile(pDataSet.Workspace.PathName, 0)<BR>    pWorkspaceEdit.StartEditOperation<BR>    pWorkspaceEdit.StartEditing True<BR>    Set pMultiLeft = New Multipoint<BR>    Set pMultiRight = New Multipoint<BR>    Set pGonColl = New Polygon<BR>    Set pMultiPoint = New Multipoint<BR>    Set pMultiPointSorted = New Multipoint<BR>    '得到所选择的图形集<BR>    Set pEnumFeature = pMxDoc.FocusMap.FeatureSelection<BR>    Set pFeature = pEnumFeature.Next<BR>    '增加点到MultiPoint<BR>    While Not pFeature Is Nothing<BR>        If pFeature.ShapeCopy.GeometryType = esriGeometryPoint Then<BR>            pMultiPoint.AddPoint pFeature.ShapeCopy<BR>        ElseIf pFeature.ShapeCopy.GeometryType = esriGeometryMultipoint Then<BR>            pMultiPoint.AddPointCollection pFeature.ShapeCopy<BR>        End If<BR>        Set pFeature = pEnumFeature.Next<BR>    Wend<BR>    If pMultiPoint.PointCount < 3 Then<BR>        MsgBox "Select a least 3 points !"<BR>        Exit Sub<BR>End If<BR>    '创建第一个Polygon<BR>    pGonColl.AddPointCollection pMultiPoint<BR>    Set pTopoOp = pGonColl<BR>    '将Polygon是否是Simple设置成未知<BR>    pTopoOp.IsKnownSimple = False<BR>    '经判断，如果不是Simple，则经过以下处理，将其转换为Simple<BR>    If pTopoOp.IsSimple = False And pMultiPoint.PointCount > 3 Then<BR>    lFlag = 1<BR>    Set pTopoOp = pMultiPoint<BR>    pTopoOp.IsKnownSimple = False<BR>    pTopoOp.Simplify<BR>    '将Multipoint进行排序<BR>    For i = 0 To pMultiPoint.PointCount - 1<BR>      For j = i + 1 To pMultiPoint.PointCount - 1<BR>        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<BR>            Set pClonei = pMultiPoint.Point(i)<BR>            Set pPointi = pClonei.Clone<BR>            '交换两点<BR>            pMultiPoint.ReplacePoints i, 1, 1, pMultiPoint.Point(j)<BR>            pMultiPoint.ReplacePoints j, 1, 1, pPointi<BR>         End If<BR>      Next<BR>Next<BR>    Set ptMin = New Point<BR>Set ptMax = New Point<BR>    '找出MultiPoint中的最大和最小点<BR> pMultiPoint.QueryPoint 0, ptMin<BR>    pMultiPoint.QueryPoint pMultiPoint.PointCount - 1, ptMax<BR>    '创建一条线段<BR>    Set pBaseLine = New Line<BR>    pBaseLine.PutCoords ptMin, ptMax<BR>    Set pBaseCurve = pBaseLine<BR>For i = 0 To pMultiPoint.PointCount - 1<BR>      Set pOutpoint = New Point<BR>      pBaseCurve.QueryPointAndDistance esriNoExtension, pMultiPoint.Point(i), False, pOutpoint, dDistAlong, dDistFrom, bIsRight<BR>      If bIsRight Then<BR>         pMultiRight.AddPoint pMultiPoint.Point(i)<BR>      Else<BR>         pMultiLeft.AddPoint pMultiPoint.Point(i)<BR>      End If<BR>    Next<BR>    Set pRingColl = New Ring<BR>    '将左边的线添加到Ring<BR>    For i = 0 To pMultiLeft.PointCount - 2<BR>      Set pLine = New Line<BR>      pLine.PutCoords pMultiLeft.Point(i), pMultiLeft.Point(i + 1)<BR>      pRingColl.AddSegment pLine<BR>    Next<BR>    '第一条线<BR>    Set pLine = New Line<BR>    pLine.PutCoords pMultiLeft.Point(pMultiLeft.PointCount - 1), pMultiRight.Point(0)<BR>    pRingColl.AddSegment pLine<BR>    '将右边的先添加到Ring<BR>    For i = (pMultiRight.PointCount - 1) To 1 Step -1<BR>      Set pLine = New Line<BR>      pLine.PutCoords pMultiRight.Point(i), pMultiRight.Point(i - 1)<BR>      pRingColl.AddSegment pLine<BR>    Next<BR>    '最后一条线<BR>    Set pLine = New Line<BR>    pLine.PutCoords pMultiRight.Point(0), pMultiLeft.Point(0)<BR>    pRingColl.AddSegment pLine<BR>    Set pRing = pRingColl<BR>    pRing.Close<BR>    Set pGonColl2 = New Polygon<BR>    pGonColl2.AddGeometry pRing<BR>    End If<BR>    If lFlag = 0 Then<BR>        Set pPolygon = pGonColl<BR>    Else<BR>        Set pPolygon = pGonColl2 'QI<BR>    End If<BR>    '画出Polygon<BR>    Set pFeatureLayer1 = pMap.Layer(1)<BR>    Set pFeatureClass1 = pFeatureLayer1.FeatureClass<BR>    Set pFeature1 = pFeatureClass1.CreateFeature<BR>    '把画的Polygon加到新建的Feature上<BR>    Set pFeature1.Shape = pPolygon<BR>    '保存Feature<BR>    pFeature1.Store<BR>    pMxDoc.ActiveView.Refresh<BR>    '停止编辑<BR>    pWorkspaceEdit.StopEditOperation<BR>    pWorkspaceEdit.StopEditing True<BR>Exit Sub</P>
<P>ErrorHander:<BR>    pWorkspaceEdit.AbortEditOperation<BR>    MsgBox Err.Description<BR>End Sub</P>

<P>为什么每次运行就显示自动化错误呢？？？？？？</P>

很不错的

支持支持..............<img src="images/post/smile/dvbbs/em04.gif" />

支持

<P>学习中,</P><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em03.gif" />

黑夜给了你黑色的眼睛，你却拿它来翻白眼！

<img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em02.gif" />

谢谢

<P>楼主辛苦了</P><img src="images/post/smile/dvbbs/em02.gif" />

很不错的想法，最好附一些说明，比如加什么类，什么组件等等。