ArcEngine开发代码集合

1

c#制作Symbol选择对话框

现在要实现双击toccontrol中的某一层的symbol调出symbol选择对话框.vb中有示例实现了类似于arcmap中的symbol选择对话框,用到了ISymbolSelector接口. 你看的是AO的例子，在ENGINE中是没有这个接口的，不过这个例子转换成C＃的代码如下： private void axTOCCtl_OnDoubleClick(object sender, ESRI.ArcGIS.TOCControl.ITOCControlEvents_OnDoubleClickEvent e) {

IBasicMap map = null; object pOther = null; object index = null; if (e.button==1) {

m_TOCControl.HitTest(e.x, e.y, ref m_TocItem, ref map, ref m_TocLayer, ref pOther, ref index); System.Drawing.Point pos=new System.Drawing.Point(e.x,e.y);

if (this.m_TocItem == esriTOCControlItem.esriTOCControlItemLegendClass) {

ESRI.ArcGIS.Carto.ILegendClass pLC=new LegendClassClass(); ESRI.ArcGIS.Carto.ILegendGroup pLG=new LegendGroupClass(); if(pOther is ILegendGroup) {

pLG=(ILegendGroup)pOther; }

pLC=pLG.get_Class((int)index); ISymbol pSym; pSym=pLC.Symbol;

ESRI.ArcGIS.DisplayUI.ISymbolSelector pSS=new ESRI.ArcGIS.DisplayUI.SymbolSelectorClass(); bool bOK=false;

pSS.AddSymbol(pSym); bOK=pSS.SelectSymbol(0); if (bOK) {

pLC.Symbol=pSS.GetSymbolAt(0); }

this.axMapCtl.ActiveView.Refresh(); this.axTOCCtl.Refresh(); } } }

那么在c#中怎么实现呢?有相应的接口吗?

如何实现在MAP空间里选择一块区域打印

如何实现在MAP空间里选择一块区域打印?用ARCENGINE里的对象实现,大家都来说说啊 把选择的区域对每一个图层做区域切割进保存为shap文件在本地． 在对每一个图层做shap文件保存的时候，同时把保存好的shap文件用本地文件的方式加载到一个MapControl控件（或者其它控件，我是自己用PictureBox来显示地图的）． 然后通过控件把显示的地图数据打印出来就可以了． 其中对图层进行切割的代码如下：

'‖================================================= '‖TrimFeatureClass2ShpFile： 裁剪到shape文件 '‖

'‖pFC： 裁剪的实体类 '‖pPolygon： 裁剪的范围

'‖strShpFileName： 输出的shape文件名 '‖bShowProgress： 是否显示进度条

'‖pTrimedFeatureClass：输出的FeatureClass '‖返回：输出的FeatureClass，nothing - 失败

'‖=================================================

Public Function TrimFeatureClass2ShpFile(pFC As esriGeoDatabase.IFeatureClass, pPolygon As esriGeometry.IPolygon, strShpFileName As String, bShowProgress As Boolean) As esriGeoDatabase.IFeatureClass On Error GoTo ErrorHandler

Set TrimFeatureClass2ShpFile = Nothing Dim i As Long Dim pos As Long

Dim pFeatureCursor As esriGeoDatabase.IFeatureCursor Dim pFeature As esriGeoDatabase.IFeature

Dim pNewFeatureCursor As esriGeoDatabase.IFeatureCursor

Dim pTopologicalOperator As esriGeometry.ITopologicalOperator

2

Dim pGeometry As esriGeometry.IGeometry

Dim pFeatureBuffer As esriGeoDatabase.IFeatureBuffer Dim pFeatureCount As Long

Dim pTrimedFeatureClass As IFeatureClass Dim nOldPercent As Integer '获取数据库系统时间

Dim pSpatialFilter As esriGeoDatabase.ISpatialFilter Set pSpatialFilter = New SpatialFilter

Dim pFeatureLayer As esriCarto.IFeatureLayer With pSpatialFilter '设置筛选器实体

Set .Geometry = pPolygon '设置筛选字段

.GeometryField = pFC.ShapeFieldName '设置空间关系

.SpatialRel = esriSpatialRelIntersects '设置查询顺序

.SearchOrder = esriSearchOrderSpatial End With

'获取筛选的实体个数

pFeatureCount = pFC.FeatureCount(pSpatialFilter) '判断筛选个数为0

If pFeatureCount = 0 Then

Set pSpatialFilter = Nothing Exit Function End If

'创建新的SHAPE文件

Set pTrimedFeatureClass = CreateNewShapefile(pFC, strShpFileName)

'判断实体类为空

If pTrimedFeatureClass Is Nothing Then '设置对象为空

Set pSpatialFilter = Nothing Exit Function End If

'获取实体指针

Set pFeatureCursor = pFC.Search(pSpatialFilter, False) Set pSpatialFilter = Nothing '获取实体

Set pFeature = pFeatureCursor.NextFeature nOldPercent = 0 '获取插入实体指针

Set pNewFeatureCursor = pTrimedFeatureClass.Insert(True) '判断实体不为空

Do While Not pFeature Is Nothing '创建实体缓冲

Set pFeatureBuffer = pTrimedFeatureClass.CreateFeatureBuffer If pFC.ShapeType = esriGeometryPolygon Then ' 若实体类型为面，则做相交

Set pTopologicalOperator = pPolygon

Set pGeometry = pTopologicalOperator.InterSect(pFeature.Shape, esriGeometry2Dimension) ElseIf pFC.ShapeType = esriGeometryPolyline Then '若实体类型为线

Set pGeometry = PolygonIntersectPolyline(pPolygon, pFeature.Shape) ElseIf pFC.ShapeType = esriGeometryPoint Then ' 若实体类型为点，则全是

Set pGeometry = pFeature.Shape

ElseIf pFC.ShapeType = esriGeometryMultipoint Then ' 若实体类型为多点

Set pGeometry = PolygonIntersectMultiPoint(pPolygon, pFeature.Shape) Else

MsgBox \不做任何裁剪！\

' 若实体类型为除点、线、面外的类型，不做裁剪 Exit Function End If

'判断实体不为空

If Not pGeometry Is Nothing Then

3

If Not pGeometry.IsEmpty Then '获取实体

Set pFeatureBuffer.Shape = pGeometry

For i = 0 To pFeature.Fields.fieldCount - 1

' 因shape字段最长只能为10位，故只比较前10位

pos= pFeatureBuffer.Fields.FindField(Left(pFeature.Fields.field(i).Name, 10)) If pos >= 0 Then

'判断实体字段类型不为几何类型并且不为OID类型并且字段可编辑并且字段不为空

If Not pFeatureBuffer.Fields.field(pos).Type = esriFieldTypeGeometry And _Not pFeatureBuffer.Fields.field(pos).Type=esriFieldTypeOIDAnd

_pFeatureBuffer.Fields.field(pos).Editable And _Not IsNull(pFeature.value(i)) Then '获取字段值

pFeatureBuffer.value(pos) = pFeature.value(i) End If End If Next i '插入实体

pNewFeatureCursor.InsertFeature pFeatureBuffer End If End If '获取实体

Set pFeature = pFeatureCursor.NextFeature

If bShowProgress Then With frmProgress

'进度条当前值加一

.ProgressBar1.value = .ProgressBar1.value + 1

If Int(.ProgressBar1.value * 100 / .ProgressBar1.Max) > nOldPercent Then

.Statuslbl1.Caption = \正在导出\& pFC.AliasName & \层，请稍候...\& Format(.ProgressBar1.value / .ProgressBar1.Max, \

nOldPercent = Int(.ProgressBar1.value * 100 / .ProgressBar1.Max) pNewFeatureCursor.Flush DoEvents End If End With End If Loop

pNewFeatureCursor.Flush

Set TrimFeatureClass2ShpFile = pTrimedFeatureClass Exit Function ErrorHandler:

Debug.Print Err.number & \End Function

以上代码要进行调试一下，因为有一些业务代码本人做了删除． 承接、合作各种GIS项目开发

：ArcGIS平（基于AO、AE、ArcIMS、ArcServer开发）

：MapInfo平台（基于MapXtreme 2004/2005、MapXtreme For Java开发） E-Mail：cmcrj0929@163.com QQ：31814576

有国土、市政、交通、电力等行业的成功应用项目经验。 自己做插值程序，想和大家分享 '''''by kisssy

'''''Kriging 以克里金插值为例

''''strName1:A string that represents your FeatureClass Path ''''strName2:A string that represents the FeatureClass Name ''''sFieldName:the field for Interpolation

Public Function Kriging(strName1 As String, strName2 As String,sFieldName As String) As IRasterLayer '克里金

'''''''''''''''''''''''''''''''''操作符 Dim pInterpolationOp As IInterpolationOp

Set pInterpolationOp = New RasterInterpolationOp '''''''''''''''''''''''''''''''''操作环境 Dim pEnv As IRasterAnalysisEnvironment Set pEnv = pInterpolationOp

'''''add shape for setting mask , this is optional Dim pFlayer As IFeatureLayer

Set pFlayer = addShp(App.Path + \大同\ Dim pGeoDB As IGeoDataset

Set pGeoDB = pFlayer.FeatureClass

4

Dim pEnvelop As IEnvelope Set pEnvelop = pGeoDB.Extent

pEnv.SetExtent esriRasterEnvValue, pEnvelop Set pEnv.Mask = pGeoDB ''''set cell size

pEnv.SetCellSize esriRasterEnvValue, 600 '600:cellsize '''''''''''''''''''''''''''''''''''设置FeatureClassDescriptor Dim pFClass As IFeatureClass

Set pFClass = OpenFC2(strName1, strName2)

Dim pFDescriptor As IFeatureClassDescriptor Set pFDescriptor = New FeatureClassDescriptor pFDescriptor.Create pFClass, Nothing, sFieldName '''''''''''''''''''''''''''''''''设置搜索半径 Dim pRadius As IRasterRadius Set pRadius = New RasterRadius

pRadius.SetVariable 12 'your variant ''''''''''''''''''''''''''''''调用Kriging Dim pOutputRaster As IRaster Set pOutputRaster = pInterpolationOp.Krige(pFDescriptor, esriGeoAnalysisSphericalSemiVariogram, pRadius, True)

'esriGeoAnalysisSphericalSemiVariogram is 'esriGeoAnalysisSemiVariogramEnum '''''''''''''''''''''''''''''输出Raster Dim pOutRasLayer As IRasterLayer Set pOutRasLayer = New RasterLayer

pOutRasLayer.CreateFromRaster pOutputRaster '''''''''''''''''''''''''着色

UsingRasterClassifyColorRampRenderer pOutRasLayer Set Kriging = pOutRasLayer End Function

Public Function addShp(strPath As String, strFcname As String) As IFeatureLayer ''''Open WorkSpace

Dim myFWKS As IFeatureWorkspace Dim myWKSF As IWorkspaceFactory

Set myWKSF = New ShapefileWorkspaceFactory Set myFWKS = myWKSF.OpenFromFile(strPath, 0) If Not myFWKS Is Nothing Then ''''Open

Dim myFC As IFeatureClass

Set myFC = myFWKS.OpenFeatureClass(strFcname) Dim myDS As IDataset Set myDS = myFC

Dim myFLayer As IFeatureLayer Set myFLayer = New FeatureLayer Set myFLayer.FeatureClass = myFC myFLayer.Name = myDS.Name Set addShp = myFLayer End If End Function

Public Function OpenFC2(strPath As String, strFcname As String) As IFeatureClass ''''Open WorkSpace

Dim myFWKS As IFeatureWorkspace Dim myWKSF As IWorkspaceFactory

Set myWKSF = New ShapefileWorkspaceFactory Set myFWKS = myWKSF.OpenFromFile(strPath, 0) If Not myFWKS Is Nothing Then ''''Open

Set OpenFC2 = myFWKS.OpenFeatureClass(strFcname) End If End Function

Public Sub UsingRasterClassifyColorRampRenderer(pRlayer As IRasterLayer) ' ' We're going to create StatsHistogram

Dim pRaster As IRaster

Set pRaster = pRlayer.Raster

Dim pStatsHist As IStatsHistogram Set pStatsHist = New StatsHistogram

Dim pCalStatsHist As IRasterCalcStatsHistogram

5

Set pCalStatsHist = New RasterCalcStatsHistogram

pCalStatsHist.ComputeFromRaster pRaster, 0, pStatsHist ' ' and then classify this data Dim pClassify As IClassify

Set pClassify = New EqualInterval Dim pClassMaxMin As IClassifyMinMax Set pClassMaxMin = pClassify

pClassMaxMin.Maximum = pStatsHist.Max pClassMaxMin.Minimum = pStatsHist.Min Dim Classes() As Double Dim ClassesCount As Long

Dim numDesiredClasses As Long

'pClassify.Classify numDesiredClasses

pClassify.Classify 8 'class count Classes = pClassify.ClassBreaks ClassesCount = UBound(Classes)

'Create classfy renderer and QI RasterRenderer interface Dim pClassRen As IRasterClassifyColorRampRenderer Set pClassRen = New RasterClassifyColorRampRenderer Dim pRasRen As IRasterRenderer Set pRasRen = pClassRen

'Set raster for the render and update Set pRasRen.Raster = pRaster

pClassRen.ClassCount = ClassesCount pRasRen.Update

'Create a color ramp to use

Dim pRamp As IAlgorithmicColorRamp Dim pColor As IColor

Set pColor = New RgbColor

Set pRamp = New AlgorithmicColorRamp pRamp.Size = ClassesCount

pColor.RGB = RGB(0, 0, 255) 'your color pRamp.FromColor = pColor pColor.RGB = RGB(255, 0, 0) pRamp.ToColor = pColor pRamp.Algorithm = 1 pRamp.CreateRamp True

'Create symbol for the classes Dim pFSymbol As IFillSymbol

Set pFSymbol = New SimpleFillSymbol

'loop through the classes and apply the color and label Dim i As Integer

For i = 0 To pClassRen.ClassCount - 1 pFSymbol.Color = pRamp.Color(i) pClassRen.Symbol(i) = pFSymbol

pClassRen.Break(i) = Classes(i + 1) Next i

'Update the renderer and plug into layer pRasRen.Update

Set pRlayer.Renderer = pClassRen Set pRaster = Nothing Set pRasRen = Nothing Set pClassRen = Nothing Set pRamp = Nothing Set pFSymbol = Nothing End Sub

希望看到大家发出更好的学习成果,给个介绍先:)

Inverse Distance to a Power（反距离加权插值法） Kriging（克里金插值法）

Minimum Curvature（最小曲率）

Modified Shepard's Method（改进谢别德法） Natural Neighbor（自然邻点插值法） Nearest Neighbor（最近邻点插值法） Polynomial Regression（多元回归法） Radial Basis Function（径向基函数法）

Triangulation with Linear Interpolation（线性插值三角网法） Moving Average（移动平均法）

46

if (e.button == 1) {

IPoint pt = MapControlYing.ToMapPoint(e.x, e.y); MapControlView.CenterAt(pt);

MapControlYing.ActiveView.PartialRefresh(esriViewDrawPhase.esriViewForeground, null } }

#endregion 例图片：

你看看这个，对你有没有用，呵呵 mapNvg是鹰眼导航MapControl控件 绘制红框 mapNvg_OnAfterDraw中

1，得到主图Extent，存放在pEnv(IEnvlope)中 2，设置绘制矩形面状符号

创建线符号，并设置颜色和宽度 pClr.RGB = vbRed(IColor)

pSmpLineSym.Color = FillColor(ISimpleLineSymbol) pSmpLineSym.Width = 1.5 设置矩形为透明样式和外边框符号 pClr.Transparency = 0

pSmpFillSym.Color = pClr(ISympleFillSymbol) pSymFillSym.Outline = pSmpLineSym 3，用设置的符号绘制矩形DrawShape

4，主图放大、缩小、漫游和全图时会触发mapMain_OnAfterDraw 过程，在其中调用mapNvg.Refresh刷新鹰眼窗口，触发 mapMain_OnAfterDraw过程绘制红框 AＥ数据加载

1、 数据加载问题：

任何系统都离不开数据的加载，下边就AE中几种常用的数据加载做一个列举。以便查阅： 1、加载个人数据库

个人数据库是保存在Access中的数据库。其加载方式有两种：通过名字和通过属性加载（也许不只这两种，AE中实现同一功能可以有多种方式）。 A、通过设置属性加载个人数据库。

首先通过IPropertySet接口定义要连接数据库的一些相关属性，在个人数据库中为数据库的路径，例如： IPropertySet ropset = new PropertySetClass();

Propset.SetProperty(\

当定义完属性并设置属性后就可以进行打开数据库的操作了，在ArcEngine开发中存在IWorkspaceFactory、IFeatureWorkspace、IFeatureClass、IFeatureLayer等几个常用的用于打开和操作数据空间地物的接口。IWorkspaceFactory是一个用于创建和打开工作空间的接口，它是一个抽象的接口，我们在具体应用时要用对应的工作空间实例化它，如下:

IWorkspaceFactory Fact = new AccessWorkspaceFactoryClass ();

如果我们打开的是SDE数据库就要用SdeWorkspaceFactoryClass实例化Fact。当我们完成了工作空间的实例化后就可以根据上边设置的属性打开对应的Access数据库了。打开方式如下：

IFeatureWorkspace Workspace = Fact.Open(Propset,0) as IFeatureWorkspace; 打开Access工作空间后接下来的事情是做什么了，很简单，找到对应的地物类，赋给相应的层，通过MapControl控件添加对应的层，然后刷新地图。以下为添加某一层的代码：

IFeatureClass Fcls = Workspace.OpenFeatureClass(\ IFeatureLayer Fly = new FeatureLayerClass(); Fly.FeatureClass = Fcls; MapCtr.Map.AddLayer (Fly); MapCtr.ActiveView.Refresh();

其中District为地物类的名字，MapCtr为AE中MapControl的对象。上边的通过属性设置加载数据空间的方式还可以用于SDE数据库，在SDE数据库加载时会介绍。 以下为通过设置属性加载Access数据库的完整C#代码： public void AddAccessDBByPro() {

IPropertySet ropset = new PropertySetClass();

Propset.SetProperty(\IWorkspaceFactory Fact = new AccessWorkspaceFactoryClass ();

IFeatureWorkspace Workspace = Fact.Open(Propset,0) as IFeatureWorkspace;

IFeatureClass Fcls = Workspace.OpenFeatureClass (\ IFeatureLayer Fly = new FeatureLayerClass(); Fly.FeatureClass = Fcls;

MapCtr.Map.AddLayer(Fly); MapCtr.ActiveView.Refresh();

47

}

B、通过数据库名字加载个人数据库

在这我先把完整的代码写出来，让您先跟上边的代码做个对比。以下为完整的代码： public void AddAccessDBByName() {

IWorkspaceName pWorkspaceName = new WorkspaceNameClass() ;

pWorkspaceName.WorkspaceFactoryProgID = \ pWorkspaceName.PathName = @\ IName n = pWorkspaceName as IName ;

IFeatureWorkspace Workspace = n.Open() as IFeatureWorkspace; IFeatureClass Fcls = Workspace.OpenFeatureClass (\ IFeatureLayer Fly = new FeatureLayerClass(); Fly.FeatureClass = Fcls; MapCtr.Map.AddLayer (Fly); MapCtr.ActiveView.Refresh(); }

细心的人已经注意到，打开Access工作空间后接下来的代码是一样的，都是找到对应的地物类，赋给相应的层，通过MapControl控件添加对应的层，然后刷新地图。现在讲解一下上边的代码，首先是创建一个个人数据库工作空间名,在指定工作空间名的ProgID，以确定打开的是什么类型的工作空间，例如在打开Access个人数据库时使用的是下边的代码：

IWorkspaceName pWorkspaceName = new WorkspaceNameClass() ;

pWorkspaceName.WorkspaceFactoryProgID = \pWorkspaceName.PathName = @\

属性WorkspaceFactoryProgID可以确保工作空间是AccessWorkspaceFactory，即个人数据库，同时指定要打开数据库的路径。为了打开数据库，我们通过AE的类图可以发现打开工作空间必须使用IName接口（个人认为，不一定正确，可以思考一下看有其他办法没有），所以接着定义IName对象，并把工作空间名转换成IName类型并赋值给IName对象，然后通过IName对象的Open()方法打开相应的工作空间,代码如下： IName n = pWorkspaceName as IName ;

IFeatureWorkspace Workspace = n.Open () as IFeatureWorkspace; 接下来的事情就是上边提到。 2、加载SDE数据库

什么是SDE数据库？这个问题要详细地讲解将花费大量的时间，但我可以告诉你SDE数据数据库可以是任何关系数据库。ESRI公司为了使空间数据能保存在关系数据库中，并且能很好的查询相关的空间属性而开发的一个中间件，使用SDE能很好的将空间数据保存在关系数据库中。如Orcale SQL Server 等。SDE具体细节的了解请查找相关的资料，这里只介绍怎么连接SDE数据库。SDE数据库的联机分为直接连接和通过SDE连接。当服务器的性能比较好的时候可以采用SDE连接，否则采用直接连接，这样可以减轻服务器的任务。建议采用直接连接，其实，SDE连接方式和直接连接的方式只是一个属性参数设置的问题。跟个人数据库采用属性连接的方式一样，先定义一个属性对象，然后设置属性参数，接着定义一个工作空间并用SdeWorkspaceFactoryClass()实例化它，接着加在加载图层,至于加载图层的代码，与加载个人数据库中图层的方法一样，其实不只加载这两种数据类型，加载其他类型的数据时也是采用相同的方法加载图层，只是工作空间采用不同的实例而已，下边为完整的对吗”//”后的为注析:

public void AddSDELayer(bool ChkSdeLinkModle) {

//定义一个属性

IPropertySet ropset = new PropertySetClass(); if (ChkSdeLinkModle==true) // 采用SDE连接 {

//设置数据库服务器名

Propset.SetProperty (\

//设置SDE的端口，这是安装时指定的，默认安装时\ Propset.SetProperty (\ //SDE的用户名

Propset.SetProperty (\ //密码

Propset.SetProperty (\

//设置数据库的名字,只有SQL Server Informix 数据库才需要设置 Propset.SetProperty (\//SDE的版本,在这为默认版本

Propset.SetProperty (\ }

else // 直接连接 {

//设置数据库服务器名,如果是本机可以用\ Propset.SetProperty (\ //SDE的用户名

Propset.SetProperty (\ //密码

Propset.SetProperty (\

48

//设置数据库的名字,只有SQL Server Informix 数据库才需要设置 Propset.SetProperty (\

//SDE的版本,在这为默认版本

Propset.SetProperty (\ }

//定义一个工作空间,并实力化为SDE的工作空间

IWorkspaceFactory Fact = new SdeWorkspaceFactoryClass(); //打开SDE工作空间,并转化为地物工作空间

IFeatureWorkspace Workspace = (IFeatureWorkspace )Fact.Open(Propset,0);

/*定义一个地物类,并打开SDE中的管点地物类,写的时候一定要写全.如SDE中有一个管点层,你不能写成IFeatureClass Fcls = Workspace.OpenFeatureClass (\管点\这样,一定要写成下边的样子.*/ IFeatureClass Fcls = Workspace.OpenFeatureClass (\管点\

IFeatureLayer Fly = new FeatureLayerClass (); Fly.FeatureClass = Fcls; MapCtr.Map.AddLayer (Fly); MapCtr.ActiveView.Refresh (); }

不知道注意到了没有,直接连接跟SDE连接的最大的不同是直接连接不要设置端口，同时他们的参数设置也不一样，好好注意参数的设置。 ３、加载CAD图层

CAD图层的加载可以分为：分图层加载和整幅图加载 A、 分图层加载

我们可以把CAD图分为点线面标注加载到MapControl中，跟加载其他数据一样，首先要定义一个工作空间，并用CadWorkspaceFactoryClass（）实例化它，当得到了工作空间后就可以打开相应的工作空间，然后再打开指定的层类型。下边为完整的代码： public void AddCADByLayer() {

//定义工作空间，并用CadWorkspaceFactoryClass()实例化它 IWorkspaceFactory Fact = new CadWorkspaceFactoryClass(); //打开相应的工作空间，并赋值给要素空间，OpenFromFile（） //中的参数为CAD文件夹的路径

IFeatureWorkspace Workspace = Fact.OpenFromFile(@\

/*打开线要素类，如果要打开点类型的要素，需要把下边的代码该成：

IFeatureClass Fcls = Workspace.OpenFeatureClass (\

由此可见modle.dwg为CAD图的名字，后边加上要打开的要素类的类型，中间用冒号 隔开，大家可以想想多边形和标注是怎么打开的。 */

IFeatureClass Fcls = Workspace.OpenFeatureClass (\

IFeatureLayer Fly = new FeatureLayerClass (); Fly.FeatureClass = Fcls; MapCtr.Map.AddLayer (Fly);

MapCtr.ActiveView.Refresh (); }

B、 整幅CAD图的加载

当我们要加载整幅CAD图时，需要使用下边的代码，这跟加载地物类有一定的区别，详细地介绍请看代码中的注析：

public void AddWholeCAD() {

／*下边的两行代码是定义一个CAD工作空间，然后打开它，但这次不是赋值给 IFeatureWorkspace对象,而是赋值给IWorkspace定义的对象*/ IWorkspaceFactory Fact = new CadWorkspaceFactoryClass();

IWorkspace Workspace = Fact.OpenFromFile(@\

//定义一个CAD画图空间，并把上边打开的工作空间赋给它

ICadDrawingWorkspace dw = Workspace as ICadDrawingWorkspace;

//定义一个CAD的画图数据集，并且打开上边指定的工作空间中一幅CAD图 //然后赋值给CAD数据集

ICadDrawingDataset ds = dw.OpenCadDrawingDataset (\ //通过ICadLayer类，把上边得到的CAD数据局赋值给ICadLayer类对象的 //CadDrawingDataset属性

ICadLayer CadLayer = new CadLayerClass(); CadLayer.CadDrawingDataset = ds; //利用MapControl加载CAD层 MapCtr.Map.AddLayer (CadLayer); MapCtr.ActiveView.Refresh (); }

49

通过上边的代码和相关的解析，大家可能对整幅CAD图的加载有一个了解，但要具体搞清楚它的含义，也不那么容易。这留给大家去慢慢体会，在这我谈谈我自己的体会，但不一定正确。要打开数据集，首先要打开它的工作空间，至于什么是工作空间，我也说不太明白，但我的理解是，如果数据是保存在文件中的，工作空间大概就是它对应的文件夹，如果是数据库中的数据，我想大概就是对应的数据库。打开数据空间后，在这因为是整幅CAD图加载，所以跟以前的有点不同，这也就是相当整个CAD图就是一个数据集，所以要转到CAD画图的工作空间，然后把CAD图作为CAD数据集打开。为了在MapControl中加载CAD层，必须使用ICadLayer控件的对象，因为MapCtr.Map.AddLayer ()方法中只能是ICadLayer的对象。

本人这几天突发奇想，想写点东西，但没有修改，有很多大字错误。敬请原谅。如果大家觉得可以。我会接着写下去。把我自己的资料整理出来。供大家分享。 本人QQ：４４８１１３１２ AE开发编辑功能

在AE中数据的编辑是一个重点，也是一个难点。它包括的东西非常多，如：地物的添加，地物的修改，地物查询，节点捕捉，地物的符号化等一系列的问题。熟练的使用地物编辑的功能，是开发一个系统必须具备的条件。数据编辑问题解决得好坏直接决定着软件是否操作方便。在这我只是写一些相应的功能函数，至于软件开发中的架构，我不考虑。 1、 添加地物

什么是地物，这是 GIS的基本概念，我在这不想多说，我只想说明一点，地物可以表现在地图上，如房子、铁路、水管等等。我们把房子的总称称为一个地物类，在AE中对应一个地物类（IFeatureClass），一个地物类在地图上表示为一个地物层（IFeatureLayer），单独的一栋房子或一条管道我们称为地物（IFeature），Arcgis中一类地物只能放在一个层，通过图层的叠加组成一幅地图。

熟悉面向对象的编程语言的人都知道，其实上边的地物类，地物的概念就是类和实体的概念。房子、铁路、水管等是一类地物的抽象，而具体的某一房子就是对象了。大家了解了这一点。接下来的开发就容易理解一些了。当然，还有一些其他的概念也必须了解一下：如长事务、短事务、编辑空间等。请大家查找一些相关资料，了解这方面的内容。

我们先开始最基本的编辑功能：添加点线面的操作。它包括输入添加点线面和通过鼠标拖动添加点线面。下边讨论一下添加点线面的基本的实现方法： 一、添加点

我们可以有多种方法添加点，但基本的思路一样，只是有少量的接口有变化。下边是通过FeatrueClass的CreateFeature（）函数添加地物。 public void AddPointByStore() {

//得到要添加地物的图层

IFeatureLayer l = MapCtr.Map.get_Layer(0) as IFeatureLayer; //定义一个地物类,把要编辑的图层转化为定义的地物类 IFeatureClass fc = l.FeatureClass ;

//先定义一个编辑的工作空间,然后把转化为数据集,最后转化为编辑工作空间, IWorkspaceEdit w = (fc as IDataset).Workspace as IWorkspaceEdit; IFeature f ; IPoint p;

//开始事务操作

w.StartEditing (false); //开始编辑

w.StartEditOperation() ;

for (int i = 0 ; i< 100 ; i++ ) {

//创建一个地物

f= fc.CreateFeature(); p = new PointClass(); //设置点的坐标 p.PutCoords (i,i); //确定图形类型 f.Shape = p; //保存地物 f.Store(); }

//结束编辑

w.StopEditOperation(); //结束事务操作

w.StopEditing(true); }

上边的代码能添加点地物，但不能作为最终的代码使用，细心的人会看到。这段代码只是把第一层加进来，然后在第一层上边添加点地物，如果第一层不是点层，该怎么办，那就要判断了。怎么判断我们以后再说。通过上边的代码，我们已经清楚地了解到，编辑地物的基本框架，这也是我们所说的事务，如果想操作能返回和重做，就必须把代码写在IWorkspaceEdit的StartEditing()和StopEditing()函数之间，把相关的操作写在IWorkspaceEdit的StartEditOperation()和StopEditOperation()之间。并且操作是利用IWorkspaceEdit接口完成的，所以要仔细理会IWorkspaceEdit接口的用处，如何工作空间都可以转化为IWorkspaceEdit的对象，当转化为IWorkspaceEdit定义的对象后，我们定义一个IFeature的对象，然后利用IFeatureClass的CreateFeature()函数创建一个地物，并赋值给定义的IFeature对象。接着设置IFeature对象的一些属性，如：坐标值，坐标系，地物类型等，最后是调用IFeature对象的Store()保存添加的地物。

50

上边的方法可以添加点地物，接着看看下边的代码。看有什么不同： public void AddPointByWrite() {

IFeatureLayer l = MapCtr.Map.get_Layer(0) as IFeatureLayer; IFeatureClass fc = l.FeatureClass ;

IFeatureClassWrite fr = fc as IFeatureClassWrite ;

IWorkspaceEdit w = (fc as IDataset).Workspace as IWorkspaceEdit; IFeature f ; IPoint p;

w.StartEditing (true); w.StartEditOperation() ;

for (int i = 0 ; i< 100 ; i++ ) {

f= fc.CreateFeature(); p = new PointClass(); p.PutCoords (i,i); f.Shape = p;

fr.WriteFeature (f); }

w.StopEditOperation(); w.StopEditing(true); }

代码中用红色标记的两行就是不同的代码，其实他就是保存方式的不同而已。在这利用了IFeatureClassWrite 接口来保存数据。再看看下边的代码：

public void AddPointByBuffer() {

IFeatureLayer l = MapCtr.Map.get_Layer(0) as IFeatureLayer; IFeatureClass fc = l.FeatureClass ;

IWorkspaceEdit w = (fc as IDataset).Workspace as IWorkspaceEdit; w.StartEditing (true); w.StartEditOperation() ; IPoint p;

IFeatureBuffer f;

IFeatureCursor cur = fc.Insert(true); for (int i = 0 ; i< 100 ; i++ ) {

f= fc.CreateFeatureBuffer(); p = new PointClass(); p.PutCoords (i,i); f.Shape = p;

cur.InsertFeature (f); }

w.StopEditOperation(); w.StopEditing(true); }

其实不同的地方就两句代码，红色表示的。在这没有再定义地物接口了（IFeature），而是使用IFeatureBuffer 接口，保存的时候是使用InsertFeature()保存，这对大数据量处理的非常有好处。他是先把要添加的保存到缓冲区里。最后一次性保存。 二、添加线

添加线的方法跟添加点一样，不同的只是地物类型不一样而已，我把代码贴出来，大家跟添加点的方式进行对比。这样便于记忆。也有利于理解。 public void AddLineByWrite() {

IFeatureLayer l = MapCtr.Map.get_Layer(0) as IFeatureLayer; IFeatureClass fc = l.FeatureClass ;

IFeatureClassWrite fr = fc as IFeatureClassWrite ;

IWorkspaceEdit w = (fc as IDataset).Workspace as IWorkspaceEdit; IFeature f ; //可选参数的设置

object Missing = Type.Missing;

IPoint p=new PointClass(); w.StartEditing (true); w.StartEditOperation() ;

for (int i = 0 ; i< 100 ; i++ ) {

f = fc.CreateFeature(); //定义一个多义线对象

IPolyline PlyLine=new PolylineClass(); //定义一个点的集合

31

Dim nFeatureNumber As Integer

n Error GoTo ErrorHandler:

If (pFeatureClass Is Nothing) Then Exit Sub End If

Set pQueryFilter = New QueryFilter

pQueryFilter.WhereClause = \ Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False) Set pFeature = pFeatureCursor.NextFeature nFeatureNumber = 0

Do While Not pFeature Is Nothing pFeature.Delete

nFeatureNumber = nFeatureNumber + 1 Set pFeature = pFeatureCursor.NextFeature Loop

MsgBox (\ \ Features\

Exit Sub rorHandler:

MsgBox Err.Description nd Sub

ivate Function OpenFeatureClass() As IFeatureClass Dim pMxDocument As IMxDocument Dim pMap As IMap

Dim pFeatureLayer As IFeatureLayer Dim pFeatureClass As IFeatureClass

n Error GoTo ErrorHandler:

Set OpenFeatureClass = Nothing

Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap If (pMap.LayerCount = 0) Then MsgBox (\缺少数据\ Exit Function End If

Set pFeatureLayer = pMap.Layer(0)

Set pFeatureClass = pFeatureLayer.FeatureClass Set OpenFeatureClass = pFeatureClass Exit Function rorHandler:

MsgBox Err.Description nd Function

ivate Sub UIButtonControl1_Click() n Error GoTo ErrorHandler:

Dim pFeatureClass As IFeatureClass Set pFeatureClass = OpenFeatureClass() DeleteFeature pFeatureClass Exit Sub rorHandler:

MsgBox Err.Description nd Sub

如何纪录排序(ITableSort)

本例要实现的是如何将一个FeatureClass中的数据按某字段的值进行排序。 ? 要点

定义ITableSort接口对象，并用TableSort类实现之，设置排序所用到的字段、排序方式（升序或降序）以及排序的数据源，然后使用ITableSort.Sort方法进行排序。

主要用到ITableSort接口。 ? 程序说明

函数OpenFeatureClass获得当前激活的Map中第一层的IFeatureClass接口对象。

函数SortFeatures按照pFeatureClass的第五个字段值对pFeatureClass的数据进行从小到大排序，并返回一个排好序的ICursor接口对象。

ivate Function SortFeatures(pFeatureClass As IFeatureClass) As ICursor

32

Dim pTableSort As ITableSort Dim pFields As IFields Dim pField As IField

Dim pQueryFilter As IQueryFilter Dim pCursor As ICursor

n Error GoTo ErrorHandler: Set SortFeatures = Nothing

Set pFields = pFeatureClass.Fields Set pField = pFields.Field(5)

Set pTableSort = New esriCore.TableSort Set pQueryFilter = New QueryFilter Set pCursor = Nothing

With pTableSort

.Fields = pField.Name

.Ascending(pField.Name) = True .CaseSensitive(pField.Name) = True Set .QueryFilter = pQueryFilter Set .Table = pFeatureClass End With

pTableSort.Sort Nothing

Set pCursor = pTableSort.Rows Set SortFeatures = pCursor If (pCursor Is Nothing) Then MsgBox (\未排序\ Else

MsgBox (\排序完成\ End If

Exit Function rorHandler:

MsgBox Err.Description nd Function

ivate Function OpenFeatureClass() As IFeatureClass Dim pMxDocument As IMxDocument Dim pMap As IMap

Dim pFeatureLayer As IFeatureLayer Dim pFeatureClass As IFeatureClass

n Error GoTo ErrorHandler:

Set OpenFeatureClass = Nothing

Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap If (pMap.LayerCount = 0) Then MsgBox (\缺少数据\ Exit Function End If

Set pFeatureLayer = pMap.Layer(0)

Set pFeatureClass = pFeatureLayer.FeatureClass Set OpenFeatureClass = pFeatureClass Exit Function rorHandler:

MsgBox Err.Description nd Function

ivate Sub UIButtonControl1_Click() n Error GoTo ErrorHandler:

Dim pFeatureClass As IFeatureClass Set pFeatureClass = OpenFeatureClass() SortFeatures pFeatureClass Exit Sub rorHandler:

MsgBox Err.Description nd Sub

33

ivate Sub UIButtonControl1_Click() n Error GoTo ErrorHandler:

Dim pFeatureClass As IFeatureClass Set pFeatureClass = OpenFeatureClass() SortFeatures pFeatureClass Exit Sub rorHandler:

MsgBox Err.Description nd Sub 如何添加字段

本例实现的是如何在一个FeatureClass中新增一个字段(Field)。 ? 要点

定义IField接口对象，并用Field类实现,通过IFieldEdit接口对象设置IField接口对象的属性,最后通过IFeatureClass.AddField方法添加一个字段。

主要用到IField接口、IFieldEdit接口和IFeatureClass接口。 ? 程序说明

函数OpenFeatureClass获得当前激活的Map中第一层的IFeatureClass接口对象。 函数AddField生成一个新的字段(Field)并添加到pFeatureClass中。 ivate Function AddField(pFeatureClass As IFeatureClass) As Boolean Dim pField As IField Dim pFieldEdit As IFieldEdit

n Error GoTo ErrorHandler: AddField = False

If (pFeatureClass Is Nothing) Then Exit Function End If

Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit .Length = 10

.Name = \

.Type = esriFieldTypeString End With

pFeatureClass.AddField pField

MsgBox (\已添加新字段:\ \ AddField = True Exit Function rorHandler:

MsgBox Err.Description nd Function ivate Function OpenFeatureClass() As IFeatureClass Dim pMxDocument As IMxDocument Dim pMap As IMap

Dim pFeatureLayer As IFeatureLayer Dim pFeatureClass As IFeatureClass

n Error GoTo ErrorHandler:

Set OpenFeatureClass = Nothing

Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap If (pMap.LayerCount = 0) Then MsgBox (\缺少数据\ Exit Function End If

Set pFeatureLayer = pMap.Layer(0)

Set pFeatureClass = pFeatureLayer.FeatureClass Set OpenFeatureClass = pFeatureClass Exit Function rorHandler:

MsgBox Err.Description nd Function

ivate Sub UIButtonControl1_Click()

34

n Error GoTo ErrorHandler: Dim pFeatureClass As IFeatureClass Set pFeatureClass = OpenFeatureClass() AddField pFeatureClass Exit Sub rorHandler:

MsgBox Err.Description nd Sub 如何删除字段

本例实现的是如何在一个FeatureClass中删除一个字段(Field)。 ? 要点

定义IField接口实例，并使用Field类实现，使用IFields.FindField方法和IFields.Field方法获得IFeatureClass中要删除的字段，最后用IFeatureClass.DeleteField方法删除字段。

主要用到IFields接口，IField接口和IFeatureClass接口。 ? 程序说明

函数OpenFeatureClass获得当前激活的Map中第一层的IFeatureClass接口对象。 函数DeleteField删除pFeatureClass中字段名为NewField的字段。 ivate Function DeleteField(pFeatureClass As IFeatureClass) As Boolean Dim pFields As IFields Dim pField As IField Dim lFieldNumber As Long

n Error GoTo ErrorHandler: DeleteField = False

If (pFeatureClass Is Nothing) Then Exit Function End If

Set pFields = pFeatureClass.Fields

lFieldNumber = pFields.FindField(\ If (lFieldNumber = -1) Then MsgBox (\无此字段\ Exit Function End If

Set pField = pFields.Field(lFieldNumber) pFeatureClass.DeleteField pField

MsgBox (\已删除字段:\ DeleteField = True

Exit Function rorHandler:

MsgBox Err.Description nd Function

ivate Function OpenFeatureClass() As IFeatureClass Dim pMxDocument As IMxDocument Dim pMap As IMap

Dim pFeatureLayer As IFeatureLayer Dim pFeatureClass As IFeatureClass

n Error GoTo ErrorHandler:

Set OpenFeatureClass = Nothing

Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap If (pMap.LayerCount = 0) Then MsgBox (\缺少数据\ Exit Function End If

Set pFeatureLayer = pMap.Layer(0)

Set pFeatureClass = pFeatureLayer.FeatureClass Set OpenFeatureClass = pFeatureClass Exit Function rorHandler:

MsgBox Err.Description nd Function

35

ivate Sub UIButtonControl1_Click() n Error GoTo ErrorHandler: Dim pFeatureClass As IFeatureClass Set pFeatureClass = OpenFeatureClass() DeleteField pFeatureClass Exit Sub rorHandler:

MsgBox Err.Description nd Sub

如何进行空间查询

本例实现的是在一个图层上画一个polygon，根据该polygon查询出图层上与之相交的polygon并高亮显示出来。 ? 要点

通过RubberPolygon类来实现接口IRubberBand接口对象，用IRubberBand.TrackNew方法在图层上画出polygon,然后定义IGeometry获得该polygon,创建ISpatialFilter接口对象实现过滤功能，通过ILayer接口实例获得IFeatureSelection接口，调用。

IFeatureSelection.SelectFeatures方法将结果高亮显示。 ption Explicit

ivate Sub UIButtonControl1_Click()

Dim pMxDoc As IMxDocument Dim pLayer As ILayer Dim pInputTable As ITable Dim pOverlayTable As ITable

Dim pFeatClassName As IFeatureClassName Dim pNewWSName As IWorkspaceName Dim pDatasetName As IDatasetName Dim dtol As Double

Dim pBasicGeop As IBasicGeoprocessor Dim pOutputFeatClass As IFeatureClass Dim pOutputFeatLayer As IFeatureLayer Dim App As VBProject

n Error GoTo ErrorHandler:

Set pMxDoc = ThisDocument

Set pLayer = pMxDoc.FocusMap.Layer(0) Set App = ThisDocument.VBProject

' Get the input table

' Use the Itable interface from the Layer (not from the FeatureClass) Set pInputTable = pLayer

' Get the overlay layer and table

' Use the Itable interface from the Layer (not from the FeatureClass) Set pLayer = pMxDoc.FocusMap.Layer(1) Set pOverlayTable = pLayer ' Error checking

If pInputTable Is Nothing Then MsgBox \ Exit Sub End If

If pOverlayTable Is Nothing Then MsgBox \ Exit Sub End If

' Define the output feature class name

Set pFeatClassName = New FeatureClassName

' Set output location and feature class name Set pNewWSName = New WorkspaceName

pNewWSName.WorkspaceFactoryProgID = \ pNewWSName.PathName = App.FileName & \

Set pDatasetName = pFeatClassName pDatasetName.Name = \

Set pDatasetName.WorkspaceName = pNewWSName

36

' Set the tolerance. Passing 0.0 causes the default tolerance to be used.

' The default tolerance is 1/10,000 of the extent of the data frame's spatial domain dtol = 0#

' Perform the union

Set pBasicGeop = New BasicGeoprocessor

Set pOutputFeatClass = pBasicGeop.Union(pInputTable, False, pOverlayTable, False, _ dtol, pFeatClassName)

' Add the output layer to the map

Set pOutputFeatLayer = New FeatureLayer

Set pOutputFeatLayer.FeatureClass = pOutputFeatClass pOutputFeatLayer.Name = pOutputFeatClass.AliasName pMxDoc.FocusMap.AddLayer pOutputFeatLayer Exit Sub

rorHandler:

MsgBox Err.Description nd Sub

如何将shape文件转化成GeoDataBase(各种文件格式的转换)

本例演示的是如何将shape文件转化成personal GeoDatabase文件，其它格式间的与此转换类似。主要用到IFeatureDataConverter接口的ConvertFeatureClass方法。 ? 要点

首先，创建新的GeoDataBase数据库，并创建IFeatureDatasetName对象。创建定义两个IFeatureClassName接口对象分别引用输入表（shape文件）和输出表。

然后设置输出表的Shape字段的GeormetryDef属性。这一步非常关键，因为其中包含了数据库和shape文件的空间参考信息。

最后调用IFeatureDataConverter.ConvertFeatureClass方法完成功能。 ? 程序说明

过程UIBConvert_Click是实现模块，调用过程ConvertShapeToGeodatabase实现功能。

sDataPath定义了数据与工程文件的相对路径。SHAPE_NAME描述了要转化的shape文件的文件名。MDB_NAME和F_DS_NAME分别描述了Access数据库名和库的数据集的名称。

ption Explicit ivate Sub UIBConvert_Click()

Call ConvertShapeToGeodatabase nd Sub

ivate Sub ConvertShapeToGeodatabase()

Dim pOutWorkspaceFactory As IWorkspaceFactory Dim pOutWorkspaceName As IWorkspaceName Dim pInWorkspaceName As IWorkspaceName Dim pOutFeatureDSName As IFeatureDatasetName Dim pOutDSName As IDatasetName Dim pInFeatureClassName As IFeatureClassName Dim pInDatasetName As IDatasetName Dim pOutFeatureClassName As IFeatureClassName Dim pOutDatasetName As IDatasetName Dim iCounter As Long Dim pOutFields As IFields Dim pInFields As IFields

Dim pFieldChecker As IFieldChecker Dim pGeoField As IField

Dim pOutGeometryDef As IGeometryDef Dim pOutGeometryDefEdit As IGeometryDefEdit Dim pName As IName Dim pInFeatureClass As IFeatureClass

Dim pShpToFeatClsConverter As IFeatureDataConverter Dim pVBProject As VBProject

Dim sDataPath As String Const SHAPE_NAME As String = \ Const MDB_NAME As String = \ Const F_DS_NAME As String = \ On Error GoTo ErrorHandler

37

Set pVBProject = ThisDocument.VBProject

sDataPath = pVBProject.FileName & \

If Not \ MsgBox MDB_NAME & \ Exit Sub Else

' Create a new Access database

Set pOutWorkspaceFactory = New AccessWorkspaceFactory

Set pOutWorkspaceName = pOutWorkspaceFactory.Create(sDataPath, MDothing, 0)

' create a new feature datset name object for the output Access feature dataset, call ' it \

Set pOutFeatureDSName = New FeatureDatasetName Set pOutDSName = pOutFeatureDSName

Set pOutDSName.WorkspaceName = pOutWorkspaceName pOutDSName.Name = F_DS_NAME

' Get the name object for the input shapefile workspace Set pInWorkspaceName = New WorkspaceName pInWorkspaceName.PathName = sDataPath

pInWorkspaceName.WorkspaceFactoryProgID = _

\ Set pInFeatureClassName = New FeatureClassName Set pInDatasetName = pInFeatureClassName pInDatasetName.Name = SHAPE_NAME

Set pInDatasetName.WorkspaceName = pInWorkspaceName

' Create the new output FeatureClass name object that will be passed ' into the conversion function

Set pOutFeatureClassName = New FeatureClassName Set pOutDatasetName = pOutFeatureClassName

' Set the new FeatureClass name to be the same as the input FeatureClass name pOutDatasetName.Name = pInDatasetName.Name

' Open the input Shapefile FeatureClass object, so that we can get its fields Set pName = pInFeatureClassName Set pInFeatureClass = pName.Open

' Get the fields for the input feature class and run them through

' field checker to make sure there are no illegal or duplicate field names Set pInFields = pInFeatureClass.Fields Set pFieldChecker = New FieldChecker

pFieldChecker.Validate pInFields, Nothing, pOutFields

' Loop through the output fields to find the geometry field For iCounter = 0 To pOutFields.FieldCount

If pOutFields.Field(iCounter).Type = esriFieldTypeGeometry Then Set pGeoField = pOutFields.Field(iCounter) Exit For End If Next iCounter

' Get the geometry field's geometry definition Set pOutGeometryDef = pGeoField.GeometryDef

' Give the geometry definition a spatial index grid count and grid size Set pOutGeometryDefEdit = pOutGeometryDef pOutGeometryDefEdit.GridCount = 1

pOutGeometryDefEdit.GridSize(0) = 1500000

' Now use IFeatureDataConverter::Convert to create the output FeatureDataset and ' FeatureClass.

Set pShpToFeatClsConverter = New FeatureDataConverter

pShpToFeatClsConverter.ConvertFeatureClass pInFeatureClassName, Nothing, _ pOutFeatureDSName, pOutFeatureClassName, Nothing, pOutFields, \

38

MsgBox \ End If

Exit Sub rorHandler:

MsgBox Err.Description nd Sub

如何将Map中显示的图形转化成栅格文件

本例要实现的是如何将当前激活的Map中显示的图形转化成栅格文件。 ? 要点

通过IMap实例获得IActiveView接口对象，定义IExporter接口变量，使用TiffExporter实现该接口并对其中的属性进行赋值，使用IActiveView.Output方法将Map中显示的图形导出。

主要用到IActiveView接口，IExporter接口和IEnvelope接口。 ? 程序说明

函数Output将当前激活的Map中显示的图形转化成栅格文件，栅格文件路径及名称由参数sFileAllName确定。

ivate Sub Output(ByVal sFileAllName As String)

Dim pMxDocument As IMxDocument Dim pActiveView As IActiveView Dim pExporter As IExporter Dim pEnvelope As IEnvelope Dim ptagRECT As tagRECT Dim pTrackCancel As ITrackCancel Dim lscreenResolution As Long

n Error GoTo ErrorHandler:

Set pMxDocument = ThisDocument

Set pActiveView = pMxDocument.ActiveView lscreenResolution = pActiveView.ScreenDisplay.DisplayTransformation.Resolution

ptagRECT.Top = 0 ptagRECT.Left = 0

ptagRECT.Right = pActiveView.Extent.Width ptagRECT.bottom = pActiveView.Extent.Height

'We must calculate the size of the user specified Rectangle in Device units 'Hence convert width and height Set pEnvelope = New Envelope

pEnvelope.PutCoords ptagRECT.Left, ptagRECT.bottom, ptagRECT.Right, ptagRECT. Set pExporter = New TiffExporter

pExporter.Resolution = lscreenResolution pExporter.ExportFileName = sFileAllName pExporter.PixelBounds = pEnvelope

Set pTrackCancel = New CancelTracker

pActiveView.Output pExporter.StartExporting, lscreenResolution, _ ptagRECT, pActiveView.Extent, pTrackCancel pExporter.FinishExporting Exit Sub rorHandler:

MsgBox Err.Description nd Sub

ivate Sub UIButtonControl1_Click()

Dim pVBProject As VBProject n Error GoTo ErrorHandler:

Set pVBProject = ThisDocument.VBProject

Output pVBProject.FileName & \ Exit Sub rorHandler:

MsgBox Err.Description nd Sub

如何拷贝属性表中的一行

本例要实现的是如何将所有属性表（Attribute Table）中的行拷贝到Windows剪贴板，使用户能使用文本编辑器等软件对选中的数据做进一步编辑，从而满足特殊要求。行中的每个属性用半角字符的逗号“,”分隔，行间用换行符分隔。

39

? 要点

首先需要取得某属性表中的所有选中记录的全部属性，以一个字符串来存储。因为在属性表中选取中记录（Row）后，层中的相应记录（Feature）也将选中。两种途径都能获得所需属性值。

得到所需的字符串sResult后，就可以将其拷贝到剪贴板。在VB中剪贴板是全局对象。可像如下使用： Clipboard.Clear

Clipboard.SetText sResult

本例将在VBA中实现相同的功能。用到了IGraphicsContianer、IGraphicsContainerSelect、ITextElement、IElement、IClipboardFormat接口。 ? 程序说明

过程UIBCopyRow_Click是实现模块，调用过程CopyRow实现功能。过程CopyRow将选中行的全部属性值（忽略Shape属性）连接成字符串，然后创建TextElement对象，并添加到IGraphicsContainer对象的选择集中，再调用TextClipboardFormat的Copy方法，把字符拷贝到Windows剪贴板。

ption Explicit ivate Sub UIBCopyRow_Click() Call CopyRow nd Sub

blic Sub CopyRow()

Dim pMxDocument As IMxDocument Dim pMap As IMap

Dim pActiveView As IActiveView

Dim pGraphicsContainer As IGraphicsContainer

Dim pGraphicsContainerS As IGraphicsContainerSelect Dim pFields As IFields Dim iCounter As Integer Dim iIndex As Integer

Dim pTextElement As ITextElement Dim pElement As IElement Dim sResult As String

Dim pEnumFeature As IEnumFeature

Dim pEnumFeatureS As IEnumFeatureSetup Dim pFeature As IFeature

Dim pClipboardFormat As IClipboardFormat On Error GoTo ErrorHandler

' Used for string operation on the clipboard

Set pClipboardFormat = New TextClipboardFormat

Set pMxDocument = ThisDocument

Set pActiveView = pMxDocument.ActivatedView Set pMap = pMxDocument.FocusMap Set pGraphicsContainer = pMap

' Get selected features to retieve their attribute values Set pEnumFeature = pMap.FeatureSelection Set pEnumFeatureS = pEnumFeature pEnumFeatureS.AllFields = True Set pFeature = pEnumFeature.Next If pFeature Is Nothing Then MsgBox \ Exit Sub End If

Set pFields = pFeature.Fields iCounter = pFields.FieldCount

Do Until pFeature Is Nothing

For iIndex = 0 To iCounter - 1

If Not TypeOf pFeature.Value(iIndex) Is IGeometry Then sResult = sResult & pFeature.Value(iIndex) & \ End If Next iIndex

' Remove the trailing comma

sResult = Left(sResult, Len(sResult) - 1) sResult = sResult & vbNewLine Set pFeature = pEnumFeature.Next Loop

40

' If you're tending to build a dll to implement the same function and ' programming in VB enviroment, simply use the next to statement ' to copy the string into windows clippboard ' Clipboard.Clear

' Clipboard.SetText sResult ' Otherwise, programe as follows

' Copy the string into clippboard using objects included in esriCore

' To clear clippboard

pClipboardFormat.Paste pMxDocument pGraphicsContainer.DeleteAllElements

' Construct a new TextElement with the string to copy into clipboard Set pTextElement = New TextElement pTextElement.Text = sResult Set pElement = pTextElement

' Point(100, 100) is for temporary use

pElement.Geometry = pActiveView.ScreenDisplay.DisplayTransformation _ .ToMapPoint(100, 100) Set pGraphicsContainer = pMap

pGraphicsContainer.AddElement pElement, 0 Set pGraphicsContainerS = pGraphicsContainer pGraphicsContainerS.UnselectAllElements pGraphicsContainerS.SelectElement pElement pClipboardFormat.copy pMxDocument

pGraphicsContainerS.UnselectElement pElement pGraphicsContainer.DeleteElement pElement pActiveView.Refresh

Exit Sub rorHandler:

MsgBox Err.Description nd Sub

如何设置和修改层的数据源

本例要实现的是如何改变（或设置）一个层的数据源（Ｄata Source）。主要用到IMapAdmin2接口。 ? 要点

首先需要得到新数据源的IFeatureClass接口对象和当前要改变数据源的层的当前IFeatureClass接口对象，然后调用IMapAdmin2接口的FireChangeFeatureClass方法实现之。 ? 程序说明

过程UICMD_ChageDataSource_Click是实现模块，调用过程ChangeLayerDataSource实现功能。 sNewFileName是层的新数据源的shape文件的完整文件名（包含）。 ivate Sub UICMD_ChageDataSource_Click() Dim pVBProject As VBProject Dim sProjectName As String Dim sNewFileName As String

n Error GoTo ErrorHandler:

Set pVBProject = ThisDocument.VBProject 'Get MXD File Path

sProjectName = pVBProject.FileName 'Get Data File Path

sNewFileName = sProjectName & \ 'Call Procedure

ChangeLayerDataSource sNewFileName Exit Sub rorHandler:

MsgBox Err.Description nd Sub

ivate Sub ChangeLayerDataSource(ByVal sNewFileName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim pWorkspace As IWorkspace

Dim pFeatureWorkspace As IFeatureWorkspace Dim pNewFeatureCls As IFeatureClass Dim pOldFeatureCls As IFeatureClass

41

Dim pMxDocument As IMxDocument Dim pMap As IMap

Dim pActiveView As IActiveView Dim pMapAdmin2 As IMapAdmin2 Dim pFeatureLayer As IFeatureLayer

n Error GoTo ErrorHandler 'Get Data FeatureClass

Set pWorkspaceFactory = New ShapefileWorkspaceFactory

Set pWorkspace = pWorkspaceFactory.OpenFromFile(sNewFileName & \ Set pFeatureWorkspace = pWorkspace

Set pNewFeatureCls = pFeatureWorkspace.OpenFeatureClass(\ 'Get Lay(0)’s FeatureClass

Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap Set pMapAdmin2 = pMap Set pActiveView = pMap

Set pFeatureLayer = pMap.Layer(0)

Set pOldFeatureCls = pFeatureLayer.FeatureClass

'Change Data Source

Set pFeatureLayer.FeatureClass = pNewFeatureCls

pMapAdmin2.FireChangeFeatureClass pOldFeatureCls, pNewFeatureCls pActiveView.Refresh

'if want to change Display in Toc ,cancel these comment below 'pFeatureLayer.Name = pNewFeatureCls.AliasName

'pMxDocument.CurrentContentsView.Refresh 0 Exit Sub

rorHandler:

MsgBox Err.Description nd Sub

如何实现在ArcMap上进行属性查询(Identify)

本例要演示的是如何查询Feature的属性信息。实现后的结果为选择了UI Tool Control后，在要查询的Feature上单击鼠标，查询的结果将显示在弹出的窗体上。 ? 要点

首先需要得到要查询的Feature对象。使用IIdentify接口的Identify方法可以对给定的位置进行查询，得到结果为IIdentifyObj对象的数组。然后通过为IIdentifyObj对象设置IFeatureIdentifyObj查询接口，即可进一步得到Feature对象。因为IFeatureIdentifyObj接口的Feature属性具有只写（write only）属性，故又用到另一个接口IRowIdentifyObj。

得到Feature对象后即可操作其Fields属性和Value属性，得到其属性字段名和值。 ? 程序说明

在窗体上使用了MSFlexGrid Control 6.0来显示查询结果。所以本例也演示了MSFlexGrid控件的使用方法。 窗体名： frmResult

MSFlexGrid控件名： flxAttr

标签控件名： lblLocation （标签用来显示查询位置的地理坐标）

Private Sub UIT_Identify_MouseDown(ByVal button As Long, ByVal shift As Long, _ ByVal x As Long, ByVal y As Long) Dim pMxApplication As IMxApplication Dim pMxDocument As IMxDocument Dim pMap As IMap Dim pPoint As IPoint Dim pIDArray As IArray Dim pIdentify As IIdentify

Dim pFeatureIdentifyObj As IFeatureIdentifyObj Dim pIdentifyObj As IIdentifyObj

Dim pRowIdentifyObj As IRowIdentifyObject Dim pFeature As IFeature Dim pFields As IFields Dim pField As IField Dim iFieldIndex As Integer Dim iLayerIndex As Integer Dim sShape As String

On Error GoTo ErrorHandler

Set pMxApplication = Application

Set pMxDocument = Application.Document

42

Set pMap = pMxDocument.FocusMap

'Identify from TOP layer to BOTTOM, exit loop since one Feature identified For iLayerIndex = 0 To pMap.LayerCount - 1 Set pIdentify = pMap.Layer(iLayerIndex)

'Convert x and y to map units

Set pPoint = pMxApplication.Display.DisplayTransformation.ToMapPoint(x, y)

'Set label on the form, coordinates would have 6 digits behind decimal point frmResult.lblLocation = \ & Format(pPoint.y, \ Set pIDArray = pIdentify.Identify(pPoint)

'Get the FeatureIdentifyObject If Not pIDArray Is Nothing Then

Set pFeatureIdentifyObj = pIDArray.Element(0) Set pIdentifyObj = pFeatureIdentifyObj pIdentifyObj.Flash pMxApplication.Display

'Feature property of FeatureIdentifyObject has write only access Set pRowIdentifyObj = pFeatureIdentifyObj Set pFeature = pRowIdentifyObj.Row Set pFields = pFeature.Fields

'Set the MSFlexGrid control on form te display identify result With frmResult.flxAttr

.AllowUserResizing = flexResizeColumns

.ColAlignment(1) = AlignmentSettings.flexAlignLeftCenter .ColWidth(0) = 1500 .ColWidth(1) = 1800

'Add header to MSFlexGrid control .Rows = pFields.FieldCount + 1 .Cols = 2

.FixedRows = 1 .FixedCols = 0

.TextMatrix(0, 0) = \ .TextMatrix(0, 1) = \

For iFieldIndex = 0 To pFields.FieldCount - 1 Set pField = pFields.Field(iFieldIndex)

'Set field \

.TextMatrix(iFieldIndex + 1, 0) = pField.Name

'Set field \ Select Case pField.Type Case esriFieldTypeOID

.TextMatrix(iFieldIndex + 1, 1) = pFeature.OID Case esriFieldTypeGeometry

'The function QueryShapeType return a String that ' correspond with the esriGeoemtryType const

sShape = QueryShapeType(pField.GeometryDef.GeometryType) .TextMatrix(iFieldIndex + 1, 1) = sShape Case Else

.TextMatrix(iFieldIndex + 1, 1) = pFeature.Value(iFieldIndex) End Select Next iFieldIndex End With

frmResult.Show modal Exit Sub End If

Next iLayerIndex

'If code goes here, no Feature was indentified, clear the MSFlex control's content ' and show a message frmResult.flxAttr.Clear

MsgBox \

43

Exit Sub ErrorHandler:

MsgBox Err.Description End Sub

Public Function QueryShapeType(ByVal enuGeometryType As esriGeometryType) As String Dim sShapeType As String

Select Case enuGeometryType Case esriGeometryPolyline sShapeType = \ Case esriGeometryPolygon sShapeType = \ Case esriGeometryPoint sShapeType = \ Case esriGeometryMultipoint sShapeType = \ Case esriGeometryNull

sShapeType = \ Case esriGeometryLine sShapeType = \ Case esriGeometryCircularArc sShapeType = \ Case esriGeometryEllipticArc sShapeType = \ Case esriGeometryBezier3Curve sShapeType = \ Case esriGeometryPath sShapeType = \ Case esriGeometryRing sShapeType = \ Case esriGeometryEnvelope sShapeType = \ Case esriGeometryAny

sShapeType = \ Case esriGeometryBag

sShapeType = \ Case esriGeometryMultiPatch sShapeType = \ Case esriGeometryTriangleStrip sShapeType = \ Case esriGeometryTriangeFan sShapeType = \ Case esriGeometryRay sShapeType = \ Case esriGeometrySphere sShapeType = \ Case Else

sShapeType = \ End Select

QueryShapeType = sShapeType End Function 计算面积和长度 一，计算面积

添加AREA字段，然后右键点击字段列，然后点击CALCULATE VALUES; --->选择ADVANCED－－》把下面的代码输入，然后在最下面=处写OUTPUT。点击OK就OK了。 Dim Output as double Dim pArea as Iarea Set pArea = [shape] Output = pArea.area 二。计算长度

同上添加LENGTH字段，然后右键点击字段列，然后点击CALCULATE VALUES; --->选择ADVANCED－－》把下面的代码输入，然后在最下面=处写OUTPUT。点击OK就OK了。 Dim Output as double Dim pCurve as ICurve Set pCurve = [shape] Output = pCurve.Length

44

把地图中的线或面的节点显示出来

private voidShowVertex(IScreenDisplayscreenDisplay, IFeaturefeature) {

ISimpleMarkerSymbolvertexMarkerSymbol = newSimpleMarkerSymbolClass(); //用来设置节点样式

ISimpleMarkerSymbolendPointMarkerSymbol = newSimpleMarkerSymbolClass(); //用来设置首尾节点样式 IRgbColorvertexColor = newRgbColorClass(); //节点颜色

IRgbColorendPointColor = newRgbColorClass(); //首尾节点颜色 IPathpath = newPathClass();

IListendPointCol = newArrayList(); doublevertexMarkerSize = 2; doubleendPointMarkerSize = 2; vertexColor.Green = 255; endPointColor.Red = 255;

vertexMarkerSymbol.Style = esriSimpleMarkerStyle.esriSMSSquare; vertexMarkerSymbol.Size = vertexMarkerSize; vertexMarkerSymbol.Angle = 0;

vertexMarkerSymbol.Color = vertexColor;

endPointMarkerSymbol.Style = esriSimpleMarkerStyle.esriSMSSquare; endPointMarkerSymbol.Size = endPointMarkerSize; endPointMarkerSymbol.Angle = 0;

endPointMarkerSymbol.Color = endPointColor; endPointCol.Clear();

if (feature.Shape.GeometryType == esriGeometryType.esriGeometryPolyline || feature.Shape.GeometryType == esriGeometryType.esriGeometryPolygon) {

//从Geometry得到GeomegryCollection

IGeometryCollectiongeoCol = (IGeometryCollection)feature.Shape; intgeomsize = geoCol.GeometryCount;

for (int lgeom = 0; lgeom < geomsize; lgeom++) {

//从GeometryCollection得到SegmentCollection

ISegmentCollectionsegCol = (ISegmentCollection)geoCol.get_Geometry(lgeom); path = (IPath)geoCol.get_Geometry(lgeom);

endPointCol.Add(path.FromPoint); //得到首尾节点 endPointCol.Add(path.ToPoint); intsegsize = segCol.SegmentCount; for(intlseg = 0; lseg < segsize; lseg++) {//重画节点

ISegmentsegment = segCol.get_Segment(lseg); //从SegmentCollection得到Segment

screenDisplay.StartDrawing(screenDisplay.hDC, (short)esriScreenCache.esriNoScreenCache); screenDisplay.SetSymbol((ISymbol)vertexMarkerSymbol);

screenDisplay.DrawPoint(segment.FromPoint); //重画Segment的端点 screenDisplay.DrawPoint(segment.ToPoint); screenDisplay.FinishDrawing(); } } }

intendsize = endPointCol.Count;

for(intlend = 0; lend < endsize; lend++) {//重画首尾节点

IPointendpoint = (IPoint)endPointCol[lend];

screenDisplay.StartDrawing(screenDisplay.hDC, (short)esriScreenCache.esriNoScreenCache); screenDisplay.SetSymbol((ISymbol)endPointMarkerSymbol); screenDisplay.DrawPoint(endpoint); screenDisplay.FinishDrawing(); } }

Engine中鹰眼的实现

者刚初学Engine，要实现鹰眼的功能，在网上看到有一些介绍，但是觉得不太适用，现给出作者的例子，供大家中有个地方作者还没有解决，就是在拉动红色矩形框时，该矩形框先不会移动，居于视图中的地图先会随着鹰眼动而移动，在鼠标停止后矩形框才会显示在鼠标停留的位置，如果有人能够完善的话，请告知作者，不胜感激。学代码如下： 量：

//鹰眼中要显示的地图范围 IEnvelope IEnv; //绘制IEv的符号 object FillSymbal;

//声明一个代理，处理MapControlView的视图大小改变时发生

private ITransformEvents_VisibleBoundsUpdatedEventHandler visBoundsUpdatedE;

45

下几个函数为功能实现部分： egion 窗体加载事件

private void Form1_Load(object sender, EventArgs e) {

//在应该上绘制矩形

CreateOverViewSymbol(); } dregion

egion 设置在鹰眼中显示的红色矩形框

private void CreateOverViewSymbol() {

IRgbColor color = new RgbColorClass(); color.RGB = 255;

ILineSymbol outline = new SimpleLineSymbol(); outline.Width = 1.5; outline.Color = color;

ISimpleFillSymbol fillsym = new SimpleFillSymbolClass(); fillsym.Outline = outline;

fillsym.Style = esriSimpleFillStyle.esriSFSHollow; FillSymbal = fillsym; }

#endregion

#region 地图绘制之后事件

private void MapControlYing_OnAfterDraw(object sender, IMapControlEvents2_OnAfterDrawEvent {

if (IEnv == null) {

return; }

esriViewDrawPhase viewDrawPhase = (esriViewDrawPhase)e.viewDrawPhase; if (viewDrawPhase == esriViewDrawPhase.esriViewForeground) {

IGeometry Geo = IEnv;

MapControlYing.DrawShape(Geo, ref FillSymbal); //GeoMove = Geo; } }

#endregion

#region 鹰眼代理-此函数会在视图范围改变时自动调用

private void visBoundsUpdated(IDisplayTransformation sender,bool sizeChanged) {

//IEnv = sender.VisibleBounds;

MapControlYing.ActiveView.PartialRefresh(esriViewDrawPhase.esriViewForeground, null, nu }

#endregion

#region 地图加载时，显示红色矩形框在鹰眼中

private void MapControlView_OnMapReplaced(object sender, IMapControlEvents2_OnMapReplacedEv {

IActiveView activeView = (IActiveView)MapControlView.ActiveView.FocusMap; IEnv = activeView.Extent;

visBoundsUpdatedE = new ITransformEvents_VisibleBoundsUpdatedEventHandler(visBoundsUpda ((ITransformEvents_Event)activeView.ScreenDisplay.DisplayTransformation).VisibleBoundsUBoundsUpdatedE; }

#endregion

#region 视图范围改变时，鹰眼的红色矩形框也随之改变

private void MapControlView_OnExtentUpdated(object sender, IMapControlEvents2_OnExtentUpdate {

IActiveView activeView = (IActiveView)MapControlView.ActiveView.FocusMap; IEnv = activeView.Extent;

visBoundsUpdatedE = new ITransformEvents_VisibleBoundsUpdatedEventHandler(visBoundsUpda ((ITransformEvents_Event)activeView.ScreenDisplay.DisplayTransformation).VisibleBoundsUBoundsUpdatedE; }

#endregion

#region 鹰眼鼠标移动事件

private void MapControlYing_OnMouseMove(object sender, IMapControlEvents2_OnMouseMoveEvent {

21

Set pFeatureClass = pFeatureLayer.FeatureClass

Set pPoint = New Point pPoint.x = CenterX pPoint.y = CenterY

Set pSegmentCollection = New Polygon

pSegmentCollection.SetCircle pPoint, Radius

Set pGeometry = pSegmentCollection Set pInvalidArea = New InvalidArea pInvalidArea.Add pSegmentCollection

Set pInvalidArea.Display = MapControl1.ActiveView.ScreenDisplay pInvalidArea.Invalidate esriAllScreenCaches End Sub

如何加载Shape文件

本例实现的是在ArcMap中连接指定的Shape文件，并将其加载到当前激活的Map中。 ? 要点

通过FeatureLayer类实现IFeatureLayer接口对象，设置IFeatureLayer.FeatureClass属性和Name属性，使用IMap.AddLayer方法将新层添加到当前地图。利用IWorkspaceFacktory接口、IFeatureWorkspace接口和IFeatureLayer接口实现连接Shape文件 ? 程序说明

函数OpenShapeFile根据输入的Shape文件路径sFilePath，将文件名为sFileName的Shape文件连接到当前激活的Map中去。

ivate Sub OpenShapeFile(ByVal sFilePath As String, ByVal sFileName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim pFeatureWorkspace As IFeatureWorkspace Dim pFeatureLayer As IFeatureLayer Dim pMxDocument As IMxDocument Dim pMap As IMap Dim sDir As String

n Error GoTo ErrorHandler:

sDir = Dir(sFilePath & \ If (sDir = \

sDir = Dir(sFilePath & \ If (sDir = \

MsgBox (\文件不存在\ Exit Sub End If End If

'Create a new ShapefileWorkspaceFactory object and open a shapefile folder Set pWorkspaceFactory = New ShapefileWorkspaceFactory

Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0)

'Create a new FeatureLayer and assign a shapefile to it Set pFeatureLayer = New FeatureLayer

Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass(sFileName) pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName

'Add the FeatureLayer to the focus map Set pMxDocument = Application.Document Set pMap = pMxDocument.FocusMap pMap.AddLayer pFeatureLayer Exit Sub rorHandler:

MsgBox Err.Description nd Sub

ivate Sub UIButtonControl1_Click()

Dim pVBProject As VBProject n Error GoTo ErrorHandler:

Set pVBProject = ThisDocument.VBProject

OpenShapeFile pVBProject.FileName & \ Exit Sub

22

rorHandler:

MsgBox Err.Description nd Sub

如何连接GeoDataBase文件

本例实现的是连接一个GeoDataBase文件，并在ArcMap中加载该GeoDataBase文件的一个表。 ? 要点

定义IWorkspaceFactory接口对象，使用AccessWorkspaceFactory类实现之。再创建IFeatureLayer接口对象，用IFeatureWorkspace.OpenFeatureClass方法加载GeoDataBase文件的一个表到IFeatureLayer.FeatureClass对象中。最后用IMap.AddLayer方法将新层添加到当前地图。

使用接口有：IWorkspaceFacktory接口、IFeatureWorkspace接口、IFeatureLayer接口和IMap接口。 ? 程序说明

函数OpenGeoDataBaseFile根据输入的GeoDataBase文件的路径（带文件名及后缀）sAllFileName连接GeoDataBase文件，再根据输入的GeoDataBase文件中的某表表名sTableName加载该表到激活的Map中去。

ivate Sub OpenGeoDataBaseFile(ByVal sAllFileName As String, ByVal sTableName As S Dim pWorkspaceFactory As IWorkspaceFactory Dim pFeatureWorkspace As IFeatureWorkspace Dim pFeatureLayer As IFeatureLayer Dim pMxDocument As IMxDocument Dim pMap As IMap Dim sDir As String

n Error GoTo ErrorHandler: sDir = Dir(sAllFileName) If (sDir = \

MsgBox (\文件不存在\ Exit Sub End If

'Create a new AccessWorkspaceFactory object and open a GeoDataBaseFile Set pWorkspaceFactory = New AccessWorkspaceFactory

Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sAllFileName, 0)

'Create a new FeatureLayer and assign a Table to it Set pFeatureLayer = New FeatureLayer

Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass(sTableName) pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName 'Add the FeatureLayer to the focus map Set pMxDocument = Application.Document Set pMap = pMxDocument.FocusMap pMap.AddLayer pFeatureLayer Exit Sub rorHandler:

MsgBox Err.Description nd Sub

ivate Sub UIButtonControl1_Click()

Dim pVBProject As VBProject n Error GoTo ErrorHandler:

Set pVBProject = ThisDocument.VBProject

OpenGeoDataBaseFile pVBProject.FileName & \ Exit Sub rorHandler:

MsgBox Err.Description nd Sub

如何连接Coverage文件

本例实现的是如何在当前激活的Map中连接一个Coverage文件。 ? 要点

使用ArcInfoWorkspaceFactory类实现IWorkSpaceFactory接口对象，用IWorkspaceFactory.Open方法打开一个Workspace，并获得Dataset对象。由于此时的Dataset对象可能有多个Coverage文件，所以要获得IEnumDataset接口对象，通过IEnumDataset.Next方法获得一个Coverage文件，并将其所有的FeatureClass放在IFeatureClassContainer对象中。最后通过IFeatureClassContainer.Class方法获得IFeatureClass接口实例，用IMap.AddLayer方法将要连接的Coverage文件的所有FeatureClass加载到当前激活的Map中。

主要用到IWorkspaceFactory接口，IWorkspace接口，IPropertySet接口，IDataset接口，IEnumDataset接口，IFeatureClassContainer接口。 ? 程序说明

函数ConnectCoverageFile将sFilePath指定的ArcInfo Workspace中的名称和sFileName相同的Coverage文件加载到当前激活的Map中。

23

ivate Sub ConnectCoverageFile(ByVal sFilePath As String, ByVal sFileName As String) Dim pWorkspace As IWorkspace

Dim pWorkspaceFactory As IWorkspaceFactory Dim pPropertySet As IPropertySet Dim pDataset As IDataset

Dim pEnumDataset As IEnumDataset

Dim pFeatureClassC As IFeatureClassContainer Dim pFeatureLayer As IFeatureLayer Dim pMxDocument As IMxDocument Dim pMap As IMap Dim nNumber As Integer Dim sWorkspace As String

n Error GoTo ErrorHandler:

sWorkspace = Dir(sFilePath, vbDirectory) If (sWorkspace = \ MsgBox (\文件不存在\ Exit Sub End If

Set pWorkspaceFactory = New ArcInfoWorkspaceFactory Set pPropertySet = New PropertySet 'canada is an arcinfoworkspace

pPropertySet.SetProperty \ 'pWorkSp is a pointer to the IArcInfoWorkspace

Set pWorkspace = pWorkspaceFactory.Open(pPropertySet, 0) 'now get to dataset objects using Idataset Set pDataset = pWorkspace

'use enum to get datasets

Set pEnumDataset = pDataset.Subsets pEnumDataset.Reset

'use FeatureClassContainer to get datasets Set pFeatureClassC = pEnumDataset.Next Do While Not pFeatureClassC Is Nothing Set pDataset = pFeatureClassC

If (pDataset.Name <> sFileName) Then

Set pFeatureClassC = pEnumDataset.Next Else

Exit Do End If Loop

'add FeatureClassContainer to map If (pFeatureClassC Is Nothing) Then MsgBox (\文件不存在\ Else

nNumber = 0

Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap

Do While nNumber < pFeatureClassC.ClassCount Set pFeatureLayer = New FeatureLayer

Set pFeatureLayer.FeatureClass = pFeatureClassC.Class(nNumber) pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName nNumber = nNumber + 1

pMap.AddLayer pFeatureLayer Loop End If Exit Sub rorHandler:

MsgBox Err.Description nd Sub

ivate Sub UIButtonControl1_Click()

Dim pVBProject As VBProject n Error GoTo ErrorHandler:

Set pVBProject = ThisDocument.VBProject

ConnectCoverageFile pVBProject.FileName & \

24

Exit Sub rorHandler:

MsgBox Err.Description nd Sub

如何连接栅格文件

本例实现的是如何在当前激活的Map中添加一个栅格文件。 ? 要点

创建一个IrasterLayer接口对象，使用IRasterLayer.CreateFromFilePath方法加载一个Raster文件，最后用IMap.AddLayer方法将IRasterLayer添加到当前激活的Map中。

主要用到IRasterLayer接口。 ? 程序说明

函数AddRasterFile将路径sFilePath下的栅格文件sFileName添加到当前激活的Map中。

ivate Sub AddRasterFile(sFilePath As String, sFileName As String) 'sFileName: the filename of the raster dataset

'sPath: the directory where the raster dataset resides Dim pRasterLy As IRasterLayer Dim pMxDoc As IMxDocument Dim pMap As IMap Dim sRasterFile As String

n Error GoTo ErrorHandler:

sRasterFile = Dir(sFilePath & sFileName) If (sRasterFile = \ MsgBox (\文件不存在\ Exit Sub End If

'Create a raster layer

Set pRasterLy = New RasterLayer

'This is only one of the three ways to create a RasterLayer object. 'If there is already a Raster or RasterDataset object, then

'method CreateFromDataset or CreateFromRaster can be used. pRasterLy.CreateFromFilePath sFilePath & sFileName 'Add the raster layer to ArcMap Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap pMap.AddLayer pRasterLy pMxDoc.ActiveView.Refresh Exit Sub rorHandler:

MsgBox Err.Description nd Sub ivate Sub UIButtonControl1_Click()

Dim pVBProject As VBProject n Error GoTo ErrorHandler:

Set pVBProject = ThisDocument.VBProject

AddRasterFile pVBProject.FileName & \ Exit Sub rorHandler:

MsgBox Err.Description nd Sub

如何创建Shape文件

本例实现的是如何创建一个Shape文件。 ? 要点

首先创建新IField接口实例，生成新字段，并获得该实例的IFieldEdit接口对象，用FieldsEdit的AddField方法将新字段加入到IFields接口对象中，最后用IFeatureWorkspace的CreateFeatureClass方法生成新的Shape文件

主要用到IFeatureWorkspace接口，IWorkspaceFactory接口，IFieldsEdit接口，IFieldEdit接口，IFeatureClass接口。

? 程序说明

函数CreatShapeFile根据输入的文件路径和文件名，创建Shape文件。

ivate Sub CreatShapeFile(ByVal sFilePath As String, ByVal sFileName As String) Dim pFeatureWorkspace As IFeatureWorkspace Dim pWorkspaceFactory As IWorkspaceFactory Dim pFields As IFields Dim pFieldsEdit As IFieldsEdit Dim pField As IField

25

Dim pFieldEdit As IFieldEdit

Dim pGeometryDef As IGeometryDef Dim pGeometryDefEdit As IGeometryDefEdit Dim pFeatClass As IFeatureClass Dim sShapeFieldName As String Dim sNewShapeFileName As String

n Error GoTo ErrorHandler:

sNewShapeFileName = Dir(sFilePath & sFileName & \ If (sNewShapeFileName <> \ MsgBox (\文件已经存在\ Exit Sub End If

sShapeFieldName = \

'Open the folder to contain the shapefile as a workspace Set pWorkspaceFactory = New ShapefileWorkspaceFactory

Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0)

'Set up a simple fields collection Set pFields = New esriCore.Fields Set pFieldsEdit = pFields

'Make the shape field

'it will need a geometry definition, with a spatial reference Set pField = New esriCore.Field Set pFieldEdit = pField

pFieldEdit.Name = sShapeFieldName pFieldEdit.Type = esriFieldTypeGeometry

Set pGeometryDef = New GeometryDef Set pGeometryDefEdit = pGeometryDef With pGeometryDefEdit

.GeometryType = esriGeometryPolygon

Set .SpatialReference = New UnknownCoordinateSystem End With

Set pFieldEdit.GeometryDef = pGeometryDef pFieldsEdit.AddField pField

'Add others miscellaneous text field Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit

.Name = \

.Type = esriFieldTypeSmallInteger End With

pFieldsEdit.AddField pField

Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit

.Name = \

.Type = esriFieldTypeInteger End With

pFieldsEdit.AddField pField

Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit

.Name = \

.Type = esriFieldTypeSingle End With

pFieldsEdit.AddField pField

Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit .Precision = 5 .Scale = 5

本文来源：https://www.bwwdw.com/article/eqkh.html