[VB+AO]如何合并两个多边形

<P>我在控件mapcontrol1中加入了一幅图片，并选择了图片中的几个多边形，我想合并他们。我在帮助找到了例子ConstructUnion of geometries Sample，不知道行不行。</P>
<P>在例子中，我删除了Dim pMxDoc As IMxDocument，Set pMxDoc = ThisDocument，把Set pEnumFeature = pMxDoc.FocusMap.FeatureSelection改为Set pEnumFeature = mapcontrol1.Map.FeatureSelection    运行出不了结果，大家帮忙改改
Option Explicit</P>
<P>'This sub Union the selected features using only the geometries with the same geometrytype than the first
'feature in the selection with a geometryType supported by ITopologicalOperator
Private Sub ConstructUnion()
   Dim pMxDoc As IMxDocument
   Dim pFeature As IFeature
   Dim pEnumFeature As IEnumFeature
   Dim pGeoDataset As IGeoDataset
   Dim pSpatialRef As ISpatialReference
   Dim pGeoBag As IGeometryCollection
   Dim pGeometry As IGeometry
   Dim pTopoOp As ITopologicalOperator2
   Dim pGeometryTemp As IGeometry
   Dim lGeometryType As Long
   Dim pTopoOpSimplify As ITopologicalOperator2
   Set pMxDoc = ThisDocument
   'Get the selected features
   Set pEnumFeature = pMxDoc.FocusMap.FeatureSelection
   Set pFeature = pEnumFeature.Next
   If pFeature Is Nothing Then
      MsgBox "You must select at least one feature ! "
      Exit Sub
   End If
   Set pGeoDataset = pFeature.Class
   'Get the spatial reference of the first feature in the enumerator
   Set pSpatialRef = pGeoDataset.SpatialReference
   Set pGeoBag = New GeometryBag
   'Set the spatial reference of the geometryBag via IGeometry
   Set pGeometry = pGeoBag 'QI
   Set pGeometry.SpatialReference = pSpatialRef
   Set pGeometryTemp = pFeature.ShapeCopy
   'Set the value of the Union GeometryType
   lGeometryType = pGeometryTemp.GeometryType
   'This loop select the first supported geometryType in one of the features
   Do While Not pFeature Is Nothing
      If lGeometryType < > esriGeometryPoint And lGeometryType < > esriGeometryMultipoint And lGeometryType < > esriGeometryPolyline And lGeometryType < > esriGeometryPolygon Then
         Set pGeometry = pFeature.ShapeCopy
         lGeometryType = pGeometryTemp.GeometryType
      Else
         Exit Do
      End If
      Set pFeature = pEnumFeature.Next
   Loop
   'Check if there is no supported type - Exit
   If lGeometryType < > esriGeometryPoint And lGeometryType < > esriGeometryMultipoint And lGeometryType < > esriGeometryPolyline And lGeometryType < > esriGeometryPolygon Then
      MsgBox "You must select at least one feature of type Point, Multipoint, Polyline or Polygon ! "
      Exit Sub
   End If
   pEnumFeature.Reset
   Set pFeature = pEnumFeature.Next
   While Not pFeature Is Nothing
   'Add only the geometry with the same geometrytype than the one determined earlier
         If pFeature.ShapeCopy.GeometryType = lGeometryType Then
            pGeoBag.AddGeometry pFeature.ShapeCopy
         End If
      Set pFeature = pEnumFeature.Next
   Wend
   'Create a new instance of a geometry
   Select Case lGeometryType
      Case esriGeometryPoint
         Set pTopoOp = New Multipoint
      Case esriGeometryMultipoint
         Set pTopoOp = New Multipoint
      Case esriGeometryPolyline
         Set pTopoOp = New Polyline
      Case esriGeometryPolygon
         Set pTopoOp = New Polygon
      Case Else
      Exit Sub
   End Select
   pTopoOp.ConstructUnion pGeoBag
   'The pTopoOp is now pointing to a geometry of type Point or Multipoint or Polyline or Polygon
   'You can use it as needed store, draw, ...
End Sub</P>

没有提示什么错误吗

你调试了没有？调用ConstructUnion的时候你有要素被选中了吗？是在哪里就运行不了还是都运行通过却没有结果呢？

<P>OK!</P><P>你的方法是正确的，但是不知道你看见最后两句注释的没有</P><P>你虽然已经完成合并，但现在只是PtopoOp指向了这个合并好的Geometry，还需要做的事情，就是</P><P>Store 和Draw</P><P>所以后面的代码改成这样试试看：</P><P> 'Create a new instance of a geometry
   Dim pge As IGeometry
  
   Select Case lGeometryType
      Case esriGeometryPoint
         Set pge = New Multipoint
      Case esriGeometryMultipoint
         Set pge = New Multipoint
      Case esriGeometryPolyline
         Set pge = New Polyline
      Case esriGeometryPolygon
         Set pge = New Polygon
      Case Else
      Exit Sub
   End Select
   Set pTopoOp = pge
  
   pTopoOp.ConstructUnion pGeoBag
  
   Dim pf1 As IFeature
   Dim pfc1 As IFeatureClass
   Dim pflayer As IFeatureLayer
    Set pflayer = MapControl1.Layer(0)
    Set pfc1 = pflayer.FeatureClass
    Set pf1 = pfc1.CreateFeature
    Set pf1.Shape = pge
  
    pf1.Value(pf1.Fields.FindField("STATE_NAME")) = "unionstate"
    pf1.Store
    MapControl1.ActiveView.Refresh</P>

Sorry，把上面的pf1.Value(pf1.Fields.FindField("STATE_NAME")) = "unionstate"注释掉

<P>kisssy斑竹，你实在太强了，毕业设计有望过关了，先谢谢各位。</P>

<P>支持下先</P>

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

<P>这个是合并两个要素层的例子</P>
<P>
<TABLE cellSpacing=0 cellPadding=2 width="75%" align=center border=0>

<TR>
<TD class=tdWhite>
<DIV>Public Sub Merge() <BR><BR>' Get the first layer in the map <BR>Dim pMxDoc As IMxDocument <BR>Set pMxDoc = ThisDocument <BR>Dim pLayer As ILayer <BR>Set pLayer = pMxDoc.FocusMap.Layer(0) <BR>Dim pFeatLayer As IFeatureLayer <BR>Set pFeatLayer = pLayer <BR>Dim pFirstFeatClass As IFeatureClass <BR>Set pFirstFeatClass = pFeatLayer.FeatureClass <BR><BR>' Get the first layer’s table <BR>' Use the Itable interface from the Layer (not from the FeatureClass) <BR>' This table defines which fields are to be used in the output <BR>Dim pFirstTable As ITable <BR>Set pFirstTable = pLayer <BR><BR>' Get the second layer and its table <BR>' Use the Itable interface from the Layer (not from the FeatureClass) <BR>Set pLayer = pMxDoc.FocusMap.Layer(1) <BR>Dim pSecondTable As ITable <BR>Set pSecondTable = pLayer <BR><BR>' Error checking <BR>If pFirstTable Is Nothing Then <BR>MsgBox "Table QI failed" <BR>Exit Sub <BR>End If <BR><BR>If pSecondTable Is Nothing Then <BR>MsgBox "Table QI failed" <BR>Exit Sub <BR>End If <BR><BR>' Define the output feature class name and shape type <BR>Dim pFeatClassName As IFeatureClassName <BR>Set pFeatClassName = New FeatureClassName <BR><BR>With pFeatClassName <BR>.FeatureType = esriFTSimple <BR>.ShapeFieldName = "Shape" <BR>.ShapeType = pFirstFeatClass.ShapeType <BR>End With <BR><BR>' Set the output location and feature class name <BR>Dim pNewWSName As IWorkspaceName <BR>Set pNewWSName = New WorkspaceName <BR><BR>With pNewWSName <BR>.WorkspaceFactoryProgID = "esriCore.ShapefileWorkspaceFactory.1" <BR>.PathName = "C:\temp" <BR>End With <BR><BR>Dim pDatasetName As IDatasetName <BR>Set pDatasetName = pFeatClassName <BR>pDatasetName.Name = "Merge_result" <BR><BR>Set pDatasetName.WorkspaceName = pNewWSName <BR><BR>' Build the input set/array – these are the layers to be merged <BR>Dim inputArray As IArray <BR>Set inputArray = New esriCore.Array ' in ArcGIS 9.0 and newer versions replace with '= New esriSystem.Array' <BR>inputArray.Add pFirstTable <BR>inputArray.Add pSecondTable <BR><BR>' Perform the merge <BR>Dim pBGP As IBasicGeoprocessor <BR>Set pBGP = New BasicGeoprocessor <BR>Dim pOutputFeatClass As IFeatureClass <BR>Set pOutputFeatClass = pBGP.Merge(inputArray, pFirstTable, pFeatClassName) <BR><BR>' Add the output to the map <BR>Dim pOutputFeatLayer As IFeatureLayer <BR>Set pOutputFeatLayer = New FeatureLayer <BR>Set pOutputFeatLayer.FeatureClass = pOutputFeatClass <BR>pOutputFeatLayer.Name = pOutputFeatClass.AliasName <BR>pMxDoc.FocusMap.AddLayer pOutputFeatLayer <BR><BR>End Sub <BR></DIV></TD></TR></TABLE></P>