|
阅读：1214回复：0
[求助]通过Ploygon中的多个Ring创建多个Ploygon
<P>在一篇有关vba-AO开发的电子文档中有“通过Ploygon中的多个Ring创建多个Ploygon”说明及程序（见下），但我将程序copy到arcmap的宏编辑器中运行时，其提示“object variable or with block vaviable not set”错误。</P>
<P>想请此处的高手们帮忙解决这个问题，①或，如果修正此程序才能运行（我的系统winxp2,arcmap9.0+sp3)；②或，请高手给出另一个更好的程序</P> <P>thanks in advance!!</P> <P>------------------------------------------------</P> <H3 ><A><FONT size=3>1.1.1.</FONT> <FONT size=3>如何通过Polygon中的多个Ring创建多个Polygon</FONT></A><p></p></H3> <P >本例要实现的是如何在一个FeatureLayer中,选择Polygon(Feature)的Shape,如果它有多个Ring,则在另一个Polygon的图层上根据每一个Ring创建一个Polygon。<p></p></P> <P >l 要点<p></p></P> <P >取出Polygon中的每个Ring,声明一个IGeometryColletion接口，将其实例化为Polygon，利用此接口的方法AddGeometry生成一个Polygon,再用一个实例化为GeometryBag的IGeometryColletion接口变量来放置生成的每个Polygon。<p></p></P> <P >l 程序说明<p></p></P> <P >程序中添加了两个图层，两层都是Polylgon型。在第一个层选择有多个Ring的Polygon,再运行本函数，则在第二个层由这些多个Ring的Polygon创建生成了多个Polygon。<p></p></P> <P >l 代码<p></p></P> <P> <TABLE cellSpacing=0 cellPadding=0 border=0> <TR > <TD vAlign=top width=473> <P >Private Function PolygonsFromPolygonRings(pGeomColl As IGeometryCollection, bClone As Boolean) As _ IGeometryCollection<p></p></P> <P > Dim i As Long<p></p></P> <P > Dim pGeometryCollection As IGeometryCollection<p></p></P> <P > Dim pTopologicalOperator As ITopologicalOperator<p></p></P> <P ><p> </p></P> <P > If Not pGeomColl Is Nothing Then<p></p></P> <P > If pGeomColl.GeometryCount > 0 Then<p></p></P> <P > Set PolygonsFromPolygonRings = New GeometryBag<p></p></P> <P > If bClone Then<p></p></P> <P > If TypeOf pGeomColl Is IClone Then<p></p></P> <P > Dim pClone As IClone<p></p></P> <P > Set pClone = pGeomColl<p></p></P> <P > Set pGeomColl = pClone.Clone<p></p></P> <P > End If<p></p></P> <P > End If<p></p></P> <P > '为每个Ring创建一个新Polygon,将Polygon进行simplify后,放在GeometryBag中<p></p></P> <P > For i = 0 To pGeomColl.GeometryCount - 1<p></p></P> <P > If pGeomColl.Geometry(i).GeometryType = esriGeometryRing Then<p></p></P> <P > Set pGeometryCollection = New Polygon<p></p></P> <P > Set pTopologicalOperator = pGeometryCollection<p></p></P> <P > pGeometryCollection.AddGeometry pGeomColl.Geometry(i)<p></p></P> <P > pTopologicalOperator.Simplify<p></p></P> <P > PolygonsFromPolygonRings.AddGeometry pGeometryCollection<p></p></P> <P > End If<p></p></P> <P > Next i<p></p></P> <P > End If<p></p></P> <P > End If<p></p></P> <P >End Function<p></p></P> <P ><p> </p></P> <P >Public Sub PolygonRingsToPolygons()<p></p></P> <P > Dim pMxDocument As IMxDocument<p></p></P> <P > Dim pMap As IMap<p></p></P> <P > Dim pActiveView As IActiveView<p></p></P> <P > Dim pEnumFeature As IEnumFeature<p></p></P> <P > Dim pFeature0 As IFeature<p></p></P> <P > Dim pFeatureLayer0 As IFeatureLayer<p></p></P> <P > Dim pFeatureClass0 As IFeatureClass<p></p></P> <P > Dim pFeature1 As IFeature<p></p></P> <P > Dim pFeatureLayer1 As IFeatureLayer<p></p></P> <P > Dim pFeatureClass1 As IFeatureClass<p></p></P> <P > Dim pPointCollection As IPointCollection<p></p></P> <P > Dim pGeometryCollection As IGeometryCollection<p></p></P> <P > Dim pDataSet As IDataset<p></p></P> <P > Dim pWorkspaceFactory As IWorkspaceFactory<p></p></P> <P > Dim pWorkspaceEdit As IWorkspaceEdit<p></p></P> <P > Dim pPolygon As IPolygon<p></p></P> <P > Dim pGeometryColPolygon As IGeometryCollection<p></p></P> <P > Dim pGeometryColPolygonNew As IGeometryCollection<p></p></P> <P > Dim pGeometryCollectionPolygon As IgeometryCollection<p></p></P> <P > Dim lGeometryIndex As Long<p></p></P> <P > Dim lPointFieldIndex As Long<p></p></P> <P > <p></p></P> <P > On Error GoTo ErrorHanlder<p></p></P> <P > '得到当前层<p></p></P> <P > Set pMxDocument = ThisDocument<p></p></P> <P > Set pMap = pMxDocument.FocusMap<p></p></P> <P > Set pActiveView = pMap<p></p></P> <P > Set pPolygon1 = New Polygon<p></p></P> <P > Set pGeometryColPolygon = New Polygon<p></p></P> <P > Set pGeometryColPolygonNew = New Polygon<p></p></P> <P > Set pGeometryColPolygonNew1 = New Polygon<p></p></P> <P > Set pGeometryCollectionPolygon = New GeometryBag<p></p></P> <P > '得到0层和1层的FeatureClass<p></p></P> <P > Set pFeatureLayer0 = pMxDocument.FocusMap.Layer(0)<p></p></P> <P > Set pFeatureClass0 = pFeatureLayer0.FeatureClass<p></p></P> <P > Set pFeatureLayer1 = pMxDocument.FocusMap.Layer(1)<p></p></P> <P > Set pFeatureClass1 = pFeatureLayer1.FeatureClass<p></p></P> <P > '建立编辑工作区<p></p></P> <P > Set pDataSet = pFeatureClass1<p></p></P> <P > Set pWorkspaceFactory = New ShapefileWorkspaceFactory<p></p></P> <P > Set pWorkspaceEdit = pWorkspaceFactory.OpenFromFile(pDataSet.Workspace.PathName, 0)<p></p></P> <P > pWorkspaceEdit.StartEditOperation<p></p></P> <P > pWorkspaceEdit.StartEditing True<p></p></P> <P > '得到Feature<p></p></P> <P > Set pEnumFeature = pMxDocument.FocusMap.FeatureSelection<p></p></P> <P > Set pFeature0 = pEnumFeature.Next<p></p></P> <P > If pFeature0 Is Nothing Then<p></p></P> <P > MsgBox "Must have Select in Position 0"<p></p></P> <P > Exit Sub<p></p></P> <P > End If<p></p></P> <P >'将一个Polygon上的多个Ring转换成多个Polygon<p></p></P> <P > Set pGeometryCollectionPolygon = PolygonsFromPolygonRings(pGeometryColPolygonNew, True)<p></p></P> <P > '将转换成的多个Polygon添加到第二层上<p></p></P> <P > For lGeometryIndex = 0 To pGeometryCollectionPolygon.GeometryCount - 1<p></p></P> <P > Set pFeature1 = pFeatureClass1.CreateFeature<p></p></P> <P > '把画的Polygon加到新建的Feature上<p></p></P> <P > Set pPolygon1 = pGeometryCollectionPolygon.Geometry(lGeometryIndex)<p></p></P> <P > Set pFeature1.Shape = pPolygon1<p></p></P> <P > '保存Feature<p></p></P> <P > pFeature1.Store<p></p></P> <P > Next<p></p></P> <P > pMxDocument.ActiveView.Refresh<p></p></P> <P > '停止编辑<p></p></P> <P > pWorkspaceEdit.StopEditOperation<p></p></P> <P > pWorkspaceEdit.StopEditing True<p></p></P> <P > Exit Sub<p></p></P> <P ><p> </p></P> <P >ErrorHanlder:<p></p></P> <P >pWorkspaceEdit.AbortEditOperation<p></p></P> <P > MsgBox Err.Description<p></p></P> <P >End Sub<p></p></P></TD></TR></TABLE></P> |
|
