ArcGIS Engine开发－自定义图层类型

Transcription

1 ArcGIS Engine 开发 - 自定义图层类型...3 ArcGIS Engine 开发 - 取得 ArcMap 文档缩略图...3 ArcSDE 中直接取得图层几何类型...4 ArcGIS Server 常见问题之一...5 IFeatureLayer.DataSourceType Property [C#]...11 IQueryFilter 接口中的 SubFileds 属性的使用...12 用程序实现从带高程的点数据到等高线的转换...13 空间查询的实现...14 创建带 Z 值的 Feature...15 在 AO 或者 ENGINE 中为 SHAPEFILE 添加 SPATIAL INDEX...19 如果把一个图层 ILayer 数据 COPY 到三维 Scenecontrol 控件中 ( 进行相关操作 )...20 vb + arcgis engine 用 raster 生成等值线源码...22 关于 IIdentify 定义时只能找到面而不能找到点和线的问题...31 使用 ArcGIS Engine 来实现地图的点击查询并闪烁...32 空间查询的实现...34 如何在同一图层中做缓冲选择...35 怎么样使用 Engine 来保存 Mxd 文件 ( 几种情况 )?...36 在 ArcGIS Engine 开发时如何改变标注字段...37 对 shape 文件添加字段...38 在 ArcGisEngine 开发中如何在 Toolbar 控件上添加 Combobox 等其他控件...40 自相交对象的处理...41 在图中加入采集点...42 创建拓扑类 投影等等...43 如何解决 shapefile 和 coverage 出现无法导入 SDE 数据库现象?...44 怎么显示布局控件的标尺...45 把 shapefile polygons 转为 polylines...45 为什么不能编辑 raster 属性表或添加字段?...46 使用 ArcGIS 将 GTOPO30 DEM 数据转换到栅格数据...47 旋转地图...47 给 geodatabase 或 shapefile 定义一个投影...49 ArcGIS Engine 中 Undo Redo 命令的使用...50 创建带 Z 值的 Feature...50 在 Ao 中如何通过查询获得 ITable...53 关于多个实体联合 (union) 的使用...54 在 Ao 中如何通过查询获得 ITable...55 在 Visual Basic 中实现 ICommand 接口...56 使用 ArcObjects 程序按照顶点来分割一条线...58 使用 AO 加载 Raster Catalog...61 把不同层的几次的选择结果加到一个选择集中...61 如何为 ArcObjects 扩展出 "GroupRenderer" 的效果来?...62 在 AO 或者 ENGINE 中为 SHAPEFILE 添加 SPATIAL INDEX...68 如何 ArcObject 的环境中用程序实现 3D 环境中的查询功能...69 截取任意范围地图区域...71 使用 AO 新增记录的 3 种方法...74

2 如何在 ArcEngine 环境中的 SceneControl 中实现查询功能...75 删除 FeatureClass 中满足一定条件的 Feature 问题及解决办法!...77 创建孤立的要素类和数据集中的要素类...78 SUM Color of vertex symbols in edit...80 要素动态跟踪的算法...83 同时闪烁满足条件的记录 n 次...86 旋转地图...89 转载 -AO 代码 Display)...94 在 arcengine 中标注字段属性数据...99 IfeatureSelection:SelectFeatures 方法介绍 AO 基本函数集合 ( 很多函数功能 ) AO 画一个多边形 AO 画带节点的线 AO 计算 Polygon 的面积 AO 缓冲区查询 AO 画一个圆 AO 查询被选中的实体 AO 绘制带节点橡皮筋线条 AO 绘制橡皮筋多边形 AO 绘制缓冲区 vb+ao 鹰眼图代码 如何利用 ao 编辑 shape 文件的某个属性的属性值 MO 作为 B/S 客户端控件的开发 MO 作为 B/S 服务器端的开发 两点间画线 创建 Personal Geodatabase ArcObject 学习的重要工具 --Object Model Diagrams ArcObject 学习的重要工具 --Object Model Diagrams ( 二 ) AO 开发感想 AO 中的组件库 (1)...143

3 ArcGIS Engine 开发 - 自定义图层类型 用 ArcGIS Engine 开发的一个特别就是面向接口编程, 每组接口代表了对象在某个方面的特性, 表现为一个方法 属性或事件 要定义自己的图层类型, 实际上只需要实现 ILayer 接口就可以 了 该接口的主要方法或属生包括 : public IEnvelope AreaOfInterest {get;} public void Draw ( esridrawphase DrawPhase, IDisplay Display, ITrackCancel trackcancel ) public void SpatialReference {set;} public string get_tiptext ( double x, double y, double Tolerance ); 等等, 请直接查阅帮助 但实现了该接口, 图层只是能加入以地图中, 并显示出来而已 如果你要自定义的图层类型是矢量要素的话, 最好直接实现 IFeatureLayer 由于 IFeatureLayer 从 ILayer 继承而来, 所以也包含了上述方法或属性 同时还可以支持选择, 查询等操作了 实现了 IFeatureLayer, 还不能支持图层渲染功能 要想支持图层渲染, 得实现 IGeoFeatureLayer 接口, 该接口从 IFeatureLayer 继承而来, 所以也包含 IFeatureLayer 所支持的所有方法属性 如果要支持属性表功能的话, 得实现 ITable 接口 如果希望图层信息能保存到 MXD 文档中, 得实现 IPersistStream 接口 由此可见, 在 ArcGIS Engine 中, 要实现自定义图层类型, 并不是一件不可能的事 虽然会比较烦琐, 但思路却非常清晰 本人就通过这种思路设计了一种组合图层, 可以同时包含点线面多种图形, 但在 TOCControl 中只表现为一个图层 当然, 这个工作要简单轻松一些, 但还是富有乐趣的 ~ ArcGIS Engine 开发 - 取得 ArcMap 文档缩略图 ArcObjects 提供了一个 IMapDocument 接口, 可以实现对 ArcMap 文档的读写操作 该接品其中有一个属性是 Thumbnail 当我们保存文档, 使用了保存缩略选项时, 会在文档中保存

4 一个缩略图 我们可以通过 Thumbnail 来读取这个缩略图 Thumbnail 的类型是 stdole.ipicture, 所以要使用它, 首先要引用 stdole private void System.Drawings.Image GetThumbnail(IMapDocument pmapdoc) { return System.Drawing.Image.FromHbitmap((IntPtr)(pMapDoc.Thumbnail.Handle)); } 一行代码搞定, 哈哈 本来就很简单嘛 好久没写了 先写这么一点吧 ArcSDE 中直接取得图层几何类型 要取得 SDE 图层要素类型, 一个方法就是打开该图层, 然后通过取得 DataSetType 属性和 FeatureType 属性来判断, 但这样做效率比较低 能不能通过 SDE 的系统表来获得呢, 答案是可以的 要有到两张系统表 :GDB_OBJECTCLASSES 和 GDB_FEATURECLASSES 其中 GDB_OBJECTCLASSES 表中相关字段有 :ID Name,GDB_FEATURECLASSES 表的相关字段是 :ObjectClassID FeatureType GeometryType, 两个表的关联关系是 : GDB_OBJECTCLASSES.ID=GDB_FEATURECLASSES.ObjectClassID 通过这两个表的关联, 就可以取得指定图层要素类型了 我们可以先通过 SQL 语句根据图层名称来获取 GDB_FEATURECLASSES 表中字段 FeatureType GeometryType 的值, 然后将其转化为对应的要素类型 转换关系请参照下面的代码 : public enum GeoType{Point,Line,Polygon,Anno,Raster,AttrTable,Unknown}; public static GeoType GetGeoType(object GeometryType,object FeatureType) { if (GeometryType == DBNull.Value) return GeoType.AttrTable; else if(geometrytype.tostring() == "2") { return GeoType.Point; } else if (GeometryType.ToString() == "3") { return GeoType.Line; } else if(geometrytype.tostring() == "4")

5 } { if (FeatureType.ToString() == "1") return GeoType.Polygon; else if (FeatureType.ToString() == "11") return GeoType.Anno; else if (FeatureType.ToString() == "14") return GeoType.Raster; else return GeoType.Unknown; } else { return GeoType.Unknown; } 通过这种方式, 速度很快, 而且可以一次读出所有图层的图层基本信息和要素类型, 速度 极快 如果这些信息要经常使用的话, 可以保存到一个哈希表中, 这样只用连接一次数据库就 OK 了 ArcGIS Server 常见问题之一 摘自 ESRI 网站, 有些内容是有限制的, 要会员才能看到 目前关于 ArcGIS Server 开发的资料非常少, 就这么一点文档, 还要限制, 不能让大家共享, 实在是罪过 现在我贴出来, 希望这些资料对一起学习 AGS 的朋友有所帮助 错误描述在 ArcCatalog 中, 当成功的创建了 server object 之后,server object 不能被预览 ArcCatalog 显示下面的错误信息 : 你的选择不能在当前视图中显示. 导致原因 server 属性中被指定的输出值和 http 位置可能不正确 解决办法所有的创建的 ArcGIS Server Objects 需要被停止 1 在 ArcCatalog 中, 右击已经添加的 ArcGIS Server, 并选择 Server 属性 2 在目录页中, 选中已经添加的输出目录并点击编辑 3 输出目录字段应该指向一个有效的目录, 比如 C:\ArcGIS\Output 如果一个虚拟目录已经被指定, 确认它是有效的, 并且看上去和下面的格式一样, 4 如果有错请更改, 然后重新创建 server object 来确认更改是否有效

6 错误描述当在 Visual Studio.NET 2003 上使用 ArcGIS Server.NET 的 ADF 模板创建一个项目时, 返回如下错误信息 : 在服务器 < 主机名 > 上的 Web 站点不可用 (Web Site on server <host> is not available) 导致原因该模板包含了调用 ' 这一 URL 的属性 如果在 IIS 中禁用了本地主机的服务, 则显示该错误信息 禁用本地服务可能是因为你的 Web 站点已经为其指定了一个 IP 地址或者是因为安全方面的考虑 解决办法启用对 的访问决定于您安装的是哪种类型的操作系统, 是服务器还是非服务器 对于非服务器的操作系统 : 1. 点击 Internet 信息服务控制台, 右键选择默认站点的属性, 打开属性对话框, 并选择网站标签页 2. 修改 IP 地址栏为 "( 全部未分配 )" 3. 重启 IIS 在 IE 浏览器中浏览刚刚启用的 服务, 在 Visual Studio.NET 2003 中用模板创建项目, 现在应该是成功的了 对于 Windows Server 操作系统 : 1. 在 Internet 信息服务控制台上创建一个新的 Web 站点 2. 为其分配 IP 地址 : 意味着只能在本地计算机上启用该站点 3. 浏览 Web 站点的根目录, 比如 C:\Inetput\wwwroot 此时在 Visual Studio.NET 2003 中用模板创建项目应该没有问题 错误描述当启动一个服务对象时, 出现下述错误信息 : 在机器 XXX 上创建 Server 环境 (Context) 失败 拒绝访问 output 文件夹 导致原因 ArcGIS Server Object Container 的帐号必须拥有虚拟文件夹的写权限 例如虚拟文件夹为 : c:\inetpub\wwwroot\temp 解决办法执行如下步骤 : 右键点击虚拟文件夹如 : c:\inetpub\wwwroot\temp 1. 选择属性 -> 安全标签页. 2. 添加帐号并赋予写权限, 使其可以读写图片. 3. 点击 OK, 关闭属性对话框.

7 错误描述使用下面的代码, 来进行使用字体中的符号进行点要素渲染的时候, 会出现地图消失的问题 下面的代码是用来生成需要在渲染过程中使用的点符号的, 使用的是宋体中 index 为 21 的字作为符号 private static ICharacterMarkerSymbol GetMarkerSymbol(IServerContext pservercontext,powernet.giscommon.symbolclass psymbolclass) { System.Drawing.Font drawfont = new System.Drawing.Font(" 宋体 ", 21); ICharacterMarkerSymbol charmarker= pservercontext.createobject("esridisplay.charactermarkersymbol") as ICharacterMarkerSymbol; charmarker.font = (stdole.ifontdisp) OLE.GetIFontDispFromFont(drawFont); charmarker.characterindex = psymbolclass.characterindex; IRgbColor prgb = pservercontext.createobject("esridisplay.rgbcolor") as IRgbColor; prgb.red=psymbolclass.symbolcolorr; prgb.green=psymbolclass.symbolcolorg; prgb.blue=psymbolclass.symbolcolorb; charmarker.color = prgb as IColor; charmarker.size = psymbolclass.symbolsize; return charmarker; } 导致原因使用 ArcGIS Engine 进行开发时, 对于点要素类, 是可以使用指定字体中的符号作为渲染的符号的, 但是在 arcgis server 的应用中来实现这个过程, 就稍微有点不同, 导致的原因还是本地对象和远程对象进行了混用? 对于 ao 对象, 可能大家都已经有这个概念, 就是一般不在本地创建对象, 但是对于其它的对象, 比如.net 中的对象, 可能就没有太注意了, 所以才导致了这个问题的出现 解决办法这个问题的解决办法是这样的, 为了避免在程序中使用下面这句代码 : System.Drawing.Font drawfont = new System.Drawing.Font(pSymbolClass.FontSymbolName, 21); 可以采用先在 *.Style 文件中把符号都配好, 然后转成 *.ServerStyle 文件, 然后使用下面的代码得到相应的符号 : private IMarkerSymbol createsymbol(iservercontext pservercontext,string index) { IStyleGallery psgallery = pservercontext.createobject("esridisplay.serverstylegallery") as IStyleGallery ;

8 IStyleGalleryStorage psgstorage = psgallery as IStyleGalleryStorage ; psgstorage.targetfile psgstorage.addfile (@"D:\xjw.ServerStyle"); IEnumStyleGalleryItem penumgitem = psgallery.get_items("markersymbols",@"d:\xjw.serverstyle",index); penumgitem.reset (); IStyleGalleryItem psgitem = penumgitem.next(); IMarkerSymbol pmsymbol = psgitem.item as IMarkerSymbol; IRgbColor prgb = pservercontext.createobject("esridisplay.rgbcolor") as IRgbColor; prgb.red=255; prgb.green =0; prgb.blue=0; pmsymbol.color=prgb; pmsymbol.size=18; penumgitem=null; psgitem=null; return pmsymbol; } 错误描述这个错误可能发生在.net 中的 ArcGIS Primary Interop Assemblies(PIA) 在错误信息中的 CLSID 可能会变化 : "COM object with CLSID {XXXX} is either not valid or not registered" 导致原因在 ArcGIS 安装中选择安装.NET 的支持,PIAs 就会为所有的 ArcGIS 库而安装上 当在尝试使用一个对象库的 PIA 时, 而这个对象库根本就没有安装时, 错误就会发生, 因为 Com 对象不能被初始化 例如,3DAnalyst 扩展模块没有被安装, 而尝试使用 ESRI.ArcGIS.Analyst3D 命名空间中的对象, 使用如下代码 : ESRI.ArcGIS.Analyst3D.IAnimationTrack atrack = new ESRI.ArcGIS.Analyst3D.AnimationTrackClass(); 一个错误就会发生 : "Error number : COM object with CLSID {4FEDC9CB-A7BE-11D5-B2A BCDDE28} is either not valid or not registered." 解决办法编程只能使用安装了的对象库 为了开发使用一个特殊的库, 那就需要重新安装 ArcGIS 产品, 确保所需的扩展模块都被安装, 以及所有的.NET 的支持选项 额外的许可会被需要 1 识别使用的对象, 以及这些对象所属的命名空间 2 识别命名空间所属的产品 例如, 为了使用 ESRI.ArcGIS.Analyst3D 命名空间中的对象, 在开发帮助中浏览库总体说明那一页 会有注解说明这个命名空间是有 ArcGIS Engine 产品的 3D 扩展模块,ArcGIS desktop 3D 扩展模块, 以及 ArcGIS Server 的 3D 扩展模块支持 3 重新安装产品, 确保所需的扩展模块得到安装, 且保证.Net 支持选项被选中

9 错误描述 当使用 ArcGIS 开发者控件开发应用程序 控件拖放于窗体上的时候, 出现以下错误信息 : " 该控件需要一个 ESRI Designer 许可 请从工程中移除该控件 " 导致原因 出现这个信息是因为 ArcGIS Engine Developer Kit 这个产品未在机器上安装并授权 ArcGIS Desktop 安装了以下控件 : -MapControl -PageLayoutControl -GlobeControl -ReaderControl -SceneControl -TOCControl -ToolbarControl ArcGIS Desktop 许可仅允许使用 MapControl 和 PageLayoutControl 进行开发或设计应用程序 剩下的其它控件许可给 ArcGIS Engine, 并仅能在 ArcGIS Engine Developer Kit 已安装并授权时用于开发 解决办法购买 ArcGIS Engine Developer Kit 产品, 并在机器上授权以下任意控件 : -GlobeControl -ReaderControl -SceneControl -TOCControl -ToolbarControl 有关如何使用这些控件的详细信息, 以及哪些控件需要对应哪些许可, 请参考 ArcGIS Developer Help 例如, 'TOCControl CoClass' 帮助主题提到, 该控件只在有 ArcGIS Engine 产品时才可用 错误描述安装出错 1935 当安装 ArcGIS Server, ArcGIS Desktop, including ArcView, ArcEditor, ArcInfo; or ArcIMS, 都可能发生如下错误 : "Error 1935: An error occured during the installation of assembly component {303994BA AE-AF1D-7AF6088EEBDB}. HRESULT: "

10 之后点击 'OK' 安装回滚退出. 导致原因导致原因这个错误发生在系统安装 (Microsoft XML Parser 4 ) 更新. 这现同样的错误信息将发生在试图安装 (Microsoft XML Parser 4.0) 的时候 ; 这也可能修改, 但是经常会因为其他产品的安装而影响系统文件破坏 解决办法步骤 : 1. 尽可能停止一些后台程序, 例如 adware 或 spyware. 有可能也停止 Adwatch, 在机器上删除所有的 adware.; 2. 尽可能停止一些 Windows 服务, 控制面板 > 管理员工具 > 服务 ; 3. 检查 Internet Explorer 6.0 的安装. 检验 Microsoft service 安装包和安装更新 ; 4. 在安装产品前请先安装 Microsoft XML 4.0 SP2, 这有可能下载其相关联的一部分 ; 5. 接着安装 ESRI 软件产品在第 4 步安装成功 ; 错误描述在操作系统是 Windows XP SP2 CPU 为 AMD Athlon 64 系列或 Pentium 4 和 Celeron-D 的机器上安装 ArcGIS 9.0 时, 出现 1904 错误, 系统无法注册一些 dll 文件 导致原因在 Windows XP SP2 中, DEP( 数据执行保护 ) 选项默认情况下是打开的, AMD 和 Intel 新的 CUP 系列中包含这个选项 数据执行保护是一套硬件和软件技术用于执行对内存的额外检查, 以保护电脑遭受恶意代码的破坏 解决办法方法一 : 移除 Windows XP 的 SP2, 然后安装 ArcGIS 9.0 方法二 : 关闭 DEP( 数据执行保护 ), 安装 ArcGIS 9.0, 安装完再激活数据执行保护 具体如下 : 1. 以管理员权限登陆 Windows XP 2. 鼠标邮件点击 我的电脑, 选择 属性 菜单 3. 点击 高级 页 4. 选择 启动与恢复 下的 设置 按钮 5. 选择默认操作系统, 如下 : "Microsoft Windows XP Professional" /fastdetect /NoExecute=OptIn 6. 点击 编辑 按钮打开 boot.ini 文件, 将其中的 /NoExecute=OptIn 改为 /NoExecute=AlwaysOff 7. 保存文件, 重新启动计算机 8. 安装 ArcGIS, 此时应该就不会出现 1904 错误了 9. 安装完 ArcGIS 以后, 将 boot.ini 文件设置改回来, 以重新激活数据执行保护的安全选项

11 IFeatureLayer.DataSourceType Property [C#] See Also IFeatureLayer Interface Language C# Visual Basic.NET Show All Data source type. [Visual Basic.NET] Public Property DataSourceType As String [C#] public string DataSourceType {get; set;} Product Availability Available with ArcGIS Engine, ArcGIS Desktop, and ArcGIS Server. Description Describes the type of data referenced by the feature layer. In ArcMap and A rccatalog this description appears on the layer's properties dialog on the Source tab after "Data Type:" Remarks By default, the DataSourceType for a layer matches the value returned by IDataset:: Category when you access the layer's feature class through IDataset. You can set a l ayer's DataSourceType to any string. Here is a list of default values for DataSourceType for common feature laye r types: Layer Type Personal Geodatabase SDE Shapefile Value "Personal Geodatabase Feature Class" "SDE Feature Class" "Shapefile Feature Class" ArcInfo or PC ArcInfo Coverage (annotation) "Annotation Feature Class"

12 ArcInfo or PC ArcInfo Coverage (point) "Point Feature Class" ArcInfo or PC ArcInfo Coverage (line) "Arc Feature Class" ArcInfo or PC ArcInfo Coverage (polygon) "Polygon Feature Class" Edge "StreetMap Feature Class" CAD (annotation) "CAD Annotation Feature Class" CAD (point) "CAD Point Feature Class" CAD (line) "CAD Polyline Feature Class" CAD (polygon) "CAD Polygon Feature Class" 把这个图层强制转换成 IFeatuerLayer, 如果转换失败就不是 shape 几何类型图层 如 IFeatureLayer ifeaturelyr = ilyr as IFeatureLayer; if(ifeaturelyr == null)... IQueryFilter 接口中的 SubFileds 属性的使用 通过一定的属性条件来查询数据是在处理数据中经常会用到的 当表中的字段非常多, 而且很多的属性字段对于这一次查询而言是多余的, 因此带着全部字段返回只会减慢查询的速度, 如果想返回符合条件的数据, 并且只需要带其中某几个自己就可以, 那么可以通过 SubFields 来指定需要的返回字段 下面的是例子代码及注释 注意 : 在取回来的要素的 FieldCount 数量还是和原来表的字段一样多, 但是没有在 subfields 中指定过的字段的值是没有返回的 过程描述 Dim pflayer As IFeatureLayer Dim player As ILayer Set player = MapControl1.Layer(0) Set pflayer = player Dim pfeatureclass As IFeatureClass Set pfeatureclass = pflayer.featureclass Dim pqueryfilter As IQueryFilter Set pqueryfilter = New QueryFilter ' 设置 SubFields 和查询条件 : pqueryfilter.subfields = "STATE_NAME,STATE_ABBR" pqueryfilter.whereclause = "STATE_NAME = 'California'"

13 ' 进行查询 : Dim pfeaturecursor As IFeatureCursor Set pfeaturecursor = pfeatureclass.search(pqueryfilter, False) Dim pfeature As IFeature Set pfeature = pfeaturecursor.nextfeature Dim pfields As IFields Set pfields = pfeature.fields Debug.Print pfields.fieldcount 用程序实现从带高程的点数据到等高线的转换 内容摘要从高程点到等高线不是一步实现的, 而是先把高程点先插值生成 TIN, 然后再从 TIN 生成等高线 在从 TIN 到等高线的生成过程中 8.3 和 9.0 上还有点区别, 请看代码注释 下面的是整个过程的代码实例 过程描述 ' 打开高程点数据 Dim pfeaturelayer As IFeatureLayer Set pfeaturelayer = MapControl1.Map.Layer(0) If pfeaturelayer Is Nothing Then Exit Sub Dim pfeatureclass As IFeatureClass Set pfeatureclass = pfeaturelayer.featureclass ' 生成 TIN Dim ptinedit As ITinEdit Dim ptinsurface As ISurface Dim ptable As ITable Set ptinedit = New Tin Set ptable = New FeatureLayer ptinedit.initnew MapControl1.ActiveView.Extent Dim pfield As IField Set pfield = pfeatureclass.fields.field(pfeatureclass.fields.findfield("well_dpth")) ptinedit.addfromfeatureclass pfeatureclass, Nothing, pfield, Nothing, 18 Set ptinsurface = ptinedit ' 打开已经创建好的空的等高线数据 ( 也可以在此时创建一个要素类 9, 如果是 9.0 版本的话, 在空等高线数据中预先需要建一个字段来存储高 ' 程值, 如果是 8.3 版本的话就不可以预先创建这样的一个高程字段, 而是在生成等高线过程中根据你指定的

14 ' 字段名称实时创建 Dim ppropset As IPropertySet Set ppropset = New PropertySet Dim pfact As IWorkspaceFactory Dim pworkspace As IWorkspace ppropset.setproperty "DATABASE", App.Path + "data" Set pfact = New ShapefileWorkspaceFactory Set pworkspace = pfact.open(ppropset, Me.hWnd) Dim pfeatureworkspace As IFeatureWorkspace Set pfeatureworkspace = pworkspace Dim pfeatureclass1 As IFeatureClass Set pfeatureclass1 = pfeatureworkspace.openfeatureclass("myshape33") ' 生成等高线 ptinsurface.contour 0, 50, pfeatureclass1, "Well_Dpth", 1 Dim pflayer As IFeatureLayer Set pflayer = New FeatureLayer Set pflayer.featureclass = pfeatureclass1 MapControl1.AddLayer pflayer MapControl1.ActiveView.Refresh 空间查询的实现 空间查询是一个经常要用到的功能, 它是通过给定一定的范围, 查询得到在这个空间范围内的要素的查询方式 下面的代码是在返回鼠标点击点周围长宽 100 个地图单位的矩形范围内的要素 过程描述 Dim pmap As IMap Dim ppoint As IPoint Set pmap = MapControl1.Map Dim pfeaturelayer As IFeatureLayer Set pfeaturelayer = pmap.layer(1)

15 Set ppoint = MapControl1.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y) Dim penv As IEnvelope Set penv = New Envelope Set penv = MapControl1.ActiveView.Extent penv.height = 100 penv.width = 100 penv.centerat ppoint MsgBox ppoint.x MsgBox penv.xmax Dim pgeometry As IGeometry Set pgeometry = penv Set pgeometry.spatialreference = pmap.spatialreference pfeaturelayer.selectable = True Dim psfilter As ISpatialFilter Set psfilter = New SpatialFilter With psfilter Set.Geometry = pgeometry.geometryfield = pfeaturelayer.featureclass.shapefieldname.spatialrel = esrispatialrelintersects End With Dim b As Boolean b = psfilter.filterownsgeometry Dim pfeaturecursor As IFeatureCursor Set pfeaturecursor = pfeaturelayer.search(psfilter, False) 创建带 Z 值的 Feature 编号 : ArcInfo Desktop,ArcGIS 相关产品及版本 : Engine Developer Kit,ArcGIS Engine Runtime 90 平台 : PC-Intel Windows2000 提交时间 : 修改时间 : 提交人 : 黄齐飞 内容摘要

16 使用 IZAware 接口, 对 Feature 设置 Z 值 例子中构建了三个点的多边形 测试条件 : 建立一个 Test.mdb 的 PGDB, 创建一个有 Z 值的多边形图层 加载图层, 运行程序 过程描述 Option Explicit Dim paoinitialize As esrisystem.iaoinitialize Dim pworkspace As esrigeodatabase.iworkspace Dim Pt1 As esrigeometry.ipoint Dim Pt2 As esrigeometry.ipoint Dim Pt3 As esrigeometry.ipoint Dim pptc As esrigeometry.ipointcollection Private Sub Form_Load() ' 许可初始化 Set paoinitialize = New AoInitialize If paoinitialize Is Nothing Then MsgBox " 不能初始化, 程序退出!" Unload Me End End If If paoinitialize.isproductcodeavailable(esrilicenseproductcodeenginegeodb) = esrilicenseavailable Then Else MsgBox " 没有合适的运行许可, 退出程序!" Unload Me End End If ' 加载数据 Dim pworkspacefactory As esrigeodatabase.iworkspacefactory Set pworkspacefactory = New esridatasourcesgdb.accessworkspacefactory Set pworkspace = pworkspacefactory.openfromfile(app.path & "test.mdb", 0) Dim pfeatureworkspace As esrigeodatabase.ifeatureworkspace Dim pfeatureclass As esrigeodatabase.ifeatureclass Dim pfeaturelayer As esricarto.ifeaturelayer Set pfeatureworkspace = pworkspace Set pfeatureclass = pfeatureworkspace.openfeatureclass("afeitest") Set pfeaturelayer = New esricarto.featurelayer Set pfeaturelayer.featureclass = pfeatureclass MapControl1.AddLayer pfeaturelayer

17 Set pfeatureclass = Nothing Set pfeatureclass = pfeatureworkspace.openfeatureclass("afeitestpolygon") Set pfeaturelayer = New esricarto.featurelayer Set pfeaturelayer.featureclass = pfeatureclass MapControl1.AddLayer pfeaturelayer Set pfeatureclass = Nothing End Sub Private Sub Form_Unload(Cancel As Integer) paoinitialize.shutdown End Sub Private Sub MapControl1_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapx As Double, ByVal mapy As Double) Dim Pt As esrigeometry.ipoint Set Pt = MapControl1.ToMapPoint(x, y) Pt.Z = 10 Dim pptzaware As esrigeometry.izaware Set pptzaware = Pt With pptzaware.zaware = True End With If Pt1 Is Nothing Then Set Pt1 = Pt ElseIf Pt2 Is Nothing Then Set Pt2 = Pt Else Set Pt3 = Pt Set pptc = New esrigeometry.polygon Dim pptczaware As esrigeometry.izaware Set pptczaware = pptc With pptczaware.zaware = True End With pptc.addpoint Pt1 pptc.addpoint Pt2 pptc.addpoint Pt3

18 pptc.addpoint Pt1 Dim pfeaturelayer As esricarto.ifeaturelayer Dim pfeatureclass As esrigeodatabase.ifeatureclass Dim pworkspaceedit As esrigeodatabase.iworkspaceedit Set pfeaturelayer = MapControl1.Layer(0) Set pfeatureclass = pfeaturelayer.featureclass Set pworkspaceedit = pworkspace pworkspaceedit.startediting True pworkspaceedit.starteditoperation Dim pfeature As esrigeodatabase.ifeature Set pfeature = pfeatureclass.createfeature With pfeature Set.Shape = pptc.store End With pworkspaceedit.stopeditoperation pworkspaceedit.stopediting True MapControl1.Refresh Set Pt1 = Nothing Set Pt2 = Nothing Set Pt3 = Nothing Set pptczaware = Nothing Set pptc = Nothing End If Set pptzaware = Nothing Set Pt = Nothing End Sub

19 在 AO 或者 ENGINE 中为 SHAPEFILE 添加 SPATIAL INDEX ArcInfo Desktop,ArcGIS Engine 编号 : 相关产品及版本 : Developer Kit 8.3,9.0,9.1 平台 : N/A 提交时间 : 修改时间 : 提交人 : 许春杰内容摘要在 ENGINE 中修改 SHAPE 文件后, 在 ARCIMS 中会出现无法正确显示, 特别是修改比较大的时候 这个时候需要重建 SHAPE 文件的 SPATAIL INDEX 过程描述重建代码如下, 可以在 AO 或者 ENGINE 中使用 Sub CheckforSpatialIndex() Dim pdoc As IMxDocument Set pdoc = ThisDocument 'Get the first layer in the map Dim player As IFeatureLayer Set player = pdoc.focusmap.layer(0) Dim pfc As IFeatureClass Set pfc = player.featureclass 'Check the shapefile to see if it 'already has a spatial index Dim pindexes As IIndexes Dim penumindex As IEnumIndex Set pindexes = pfc.indexes Set pindexes = pfc.indexes If pindexes.findindexesbyfieldname("shape").next Is Nothing Then Debug.Print pfc.aliasname Call AddMyIndex(pFc, pfc.shapefieldname) End If End Sub Public Sub AddMyIndex(pFc As IFeatureClass, strfieldname As String) 'Set up fields Dim pfields As IFields Dim pfieldsedit As IFieldsEdit Dim pfield As IField Dim lfld As Long Set pfields = New Fields Set pfieldsedit = pfields pfieldsedit.fieldcount = 1

20 lfld = pfc.findfield(strfieldname) Set pfield = pfc.fields.field(lfld) Set pfieldsedit.field(0) = pfield Dim pindex As IIndex Dim pindexedit As IIndexEdit Set pindex = New Index 'QI for IIndexEdit Set pindexedit = pindex With pindexedit Set.Fields = pfields.name = "Idx_1" End With 'Add index to feature class pfc.addindex pindex End Sub 如果把一个图层 ILayer 数据 COPY 到三维 Scenecontrol 控件 中 ( 进行相关操作 ) ArcGIS Engine Developer Kit,ArcGIS 编号 : 相关产品及版本 : 平台 : Engine Runtime win 提交时间 : 修改时间 : 提交人 : 谭军辉内容摘要把 Mapcontrol 中的数据或一个 ILayer 图层的数据或一个选择集的数据 COPY 到 Scenecontrol 三维控件中来 过程描述 Dim pfeatureselection As IFeatureSelection Dim pspatialfilter As ISpatialFilter Dim pfeaturelayerdefinition As IFeatureLayerDefinition Dim pfeaturelayermx As IFeatureLayer Dim pfeaturelayersx As IFeatureLayer Dim p3dproperties As I3DProperties Dim pgeofeaturelayermx As IGeoFeatureLayer Dim pgeofeaturelayersx As IGeoFeatureLayer

21 Dim playersx As ILayer Dim pcolor As IColor Dim psymbol As ISymbol Dim pobjectcopy As IObjectCopy 'esricontrolssupport.iobjectcopy ' Dim plistitems As MSComctlLib.ListItems Dim plistitem As MSComctlLib.ListItem ' ' Select Features That pass through the current extent ' Set playersx = Nothing If TypeOf playermx Is IFeatureLayer Then Set pfeaturelayermx = playermx If pfeaturelayermx.featureclass.featuretype = esriftsimple Then Set pspatialfilter = New SpatialFilter Set pspatialfilter.geometry = menvelope ' ' pspatialfilter.geometryfield = pfeaturelayermx.featureclass.shapefieldname pspatialfilter.spatialrel = esrispatialrelintersects ' Set pfeatureselection = pfeaturelayermx Call pfeatureselection.selectfeatures(pspatialfilter, esriselectionresultnew, False) ' Set pfeaturelayerdefinition = pfeaturelayermx Set pfeaturelayersx = pfeaturelayerdefinition.createselectionlayer(pfeaturelayermx.name, True, "", "") pfeaturelayersx.visible = pfeaturelayermx.visible ' Call pfeatureselection.clear ' Set pgeofeaturelayermx = pfeaturelayermx Set pgeofeaturelayersx = pfeaturelayersx Set pobjectcopy = New ObjectCopy Set pgeofeaturelayersx.renderer = pobjectcopy.copy(pgeofeaturelayermx.renderer) ' Set playersx = pfeaturelayersx End If Else If TypeOf playermx Is IRasterLayer Then Dim prasterlayermx As IRasterLayer Set prasterlayermx = playermx prasterlayermx.visibleextent = menvelope

22 Set playersx = prasterlayermx End If End If ' ' Add Layer to ArcScene 其中 mscenegraph 为控件名称 ' Call mscenegraph.scene.addlayer(playersx, False) ' ' Update 3D Properties of SxLayer ' Set p3dproperties = Get3DPropertiesFromLayer(pLayerSx) If Not (p3dproperties Is Nothing) Then ' p3dproperties.baseexpressionstring = "0" ' p3dproperties.baseoption = esribaseshape p3dproperties.depthpriorityvalue = ppriority ' p3dproperties.extrusionexpressionstring = "" ' p3dproperties.extrusiontype = esriextrusionnone ' p3dproperties.faceculling = esrifacecullingnone ' p3dproperties.illuminate = True ' p3dproperties.offsetexpressionstring = "0" ' p3dproperties.rendermode = esrirendercache ' p3dproperties.renderrefreshrate = 0.75 ' p3dproperties.rendervisibility = esrirenderalways ' p3dproperties.smoothshading = True ' p3dproperties.zfactor = 1 ' Call p3dproperties.apply3dproperties(playersx) End If ' End If ' vb + arcgis engine 用 raster 生成等值线源码 vb + engine 用 raster 生成等值线源码

23 Public Function CreateRasterFromPoint(pMap As IMap, sname As String, sfieldname As String, dcellsize As Double, stroutname As String) CheckSpatialAnalystLicense Dim pfilt As IQueryFilter Set pfilt = New QueryFilter Dim i As Integer Dim nlayerindex As Integer nlayerindex = -1 For i = 0 To pmap.layercount() - 1 If pmap.layer(i).name = sname Then nlayerindex = i Exit For End If Next i If nlayerindex = -1 Then MsgBox " 生成等值线的原始数据不存在!" Exit Function End If Dim pfeaturelayer As IFeatureLayer Set pfeaturelayer = pmap.layer(nlayerindex) Dim pfclass As IFeatureClass Set pfclass = pfeaturelayer.featureclass ' Create FeatureClassDescriptor using a value field Dim pfdescr As IFeatureClassDescriptor Set pfdescr = New FeatureClassDescriptor If Len(m_sWhereClause) > 0 Then pfilt.whereclause = m_swhereclause pfdescr.create pfclass, pfilt, sfieldname Else

24 pfdescr.create pfclass, Nothing, sfieldname End If ' Create RasterInterpolationOp object Dim pintop As IInterpolationOp Set pintop = New RasterInterpolationOp ' Set cell size for output raster. The extent of the output raster is ' defualted to as same as input. The output working directory uses default Dim pextent As IEnvelope Set pextent = New Envelope Dim xmin As Double Dim xmax As Double Dim ymin As Double Dim ymax As Double xmin = xmax = ymin = ymax = pextent.putcoords xmin, ymin, xmax, ymax Dim penv As IRasterAnalysisEnvironment Set penv = pintop penv.setcellsize esrirasterenvvalue, dcellsize penv.setextent esrirasterenvvalue, pextent ' Create raster radius using variable distance Dim pradius As IRasterRadius Set pradius = New RasterRadius pradius.setvariable 12 ' Using FeatureClassDescriptor as an input to the IInterpolationOp and ' Perform the interpolation Dim pinraster As IRaster Set pinraster = pintop.idw(pfdescr, 2, pradius) Dim prasterprop As IRasterProps Set prasterprop = pinraster

25 RULX = prasterprop.extent.xmin RULY = prasterprop.extent.ymax RLRX = prasterprop.extent.xmax RLRY = prasterprop.extent.ymin ' 判断 stroutname 是否存在, 如果存在, 删除先 Call DeleteIfExists(strOutName) Dim pgeo As IGeometry Set pgeo = GetPolygon ' 用边界裁剪 raster RasterExtraction pgeo, pinraster Dim poutdataset As IDataset Set poutdataset = poutbands.saveas(stroutname, Nothing, "GRID") Set pfilt = Nothing Set pfdescr = Nothing Set pintop = Nothing Set pextent = Nothing Set pfeaturelayer = Nothing Set pfclass = Nothing End Function Public Sub CheckSpatialAnalystLicense() ' This module is used to check in the SpatialAnalyst license ' in a standalone VB application. On Error GoTo ERH ' Get Spatial Analyst Extension UID Dim puid As New UID puid.value = "esrigeoanalyst.saextension.1" ' Add Spatial Analyst extension to the license manager Dim v As Variant Dim plicadmin As IExtensionManagerAdmin Set plicadmin = New ExtensionManager Call plicadmin.addextension(puid, v) ' Enable the license Dim plicmanager As IExtensionManager

26 Set plicmanager = plicadmin Dim pextensionconfig As IExtensionConfig Set pextensionconfig = plicmanager.findextension(puid) pextensionconfig.state = esriesenabled Exit Sub ERH: MsgBox "Failed in License Checking" & Err.Description End Sub Public Function RasterExtraction(theOverlay As IGeometry, theraster As IRaster) On Error GoTo ErrHand: 'Check Spatial Analyst's Licence CheckSpatialAnalystLicense Dim piexop As IExtractionOp Dim pingeodata As IGeoDataset, poutgeodata As IGeoDataset Dim prenvelope As IEnvelope Set piexop = New RasterExtractionOp Dim pbands As IRasterBandCollection Set pbands = theraster Set pingeodata = pbands Dim XCellSize As Double Dim YCellSize As Double Dim pinrasterprop As IRasterProps Set prenvelope = pingeodata.extent Set pinrasterprop = theraster XCellSize = prenvelope.width / pinrasterprop.width YCellSize = prenvelope.height / pinrasterprop.height Set penvelop = CheckEnvelop(theOverlay.Envelope, prenvelope, XCellSize, YCellSize) 'Fit envelop the cell position of Raster Dim ppolygon As IPolygon Dim prbnd As IRaster Dim pcopbands As IRasterBandCollection Dim prasterprop As IRasterProps Set prasterprop = New Raster prasterprop.extent = penvelop prasterprop.height = Int(pEnvelop.Height / YCellSize) prasterprop.width = Int(pEnvelop.Width / XCellSize) Set pinrasterprop = Nothing Set poutbands = prasterprop

27 Set ppolygon = pfeat.shape Dim i As Integer For i = 0 To pbands.count - 1 Set pingeodata = pbands.item(i) Set poutgeodata = piexop.polygon(pingeodata, ppolygon, True) Set prbnd = poutgeodata Set pcopbands = prbnd poutbands.add pcopbands.item(0), i Next If Not poutgeodata Is Nothing Then Set praster = poutgeodata Exit Function Else MsgBox "nothing" End If ErrHand: MsgBox "RasterExtraction - " & Err.Description End Function Public Function CheckEnvelop(DEnv As IEnvelope, REnv As IEnvelope, CX As Double, CY As Double) As IEnvelope Set CheckEnvelop = New Envelope CheckEnvelop.xmin = (Int((DEnv.xmin - REnv.xmin) / CX) * CX) + REnv.xmin CheckEnvelop.xmax = ((Int((DEnv.xmax - REnv.xmin) / CX) + 1) * CX) + REnv.xmin CheckEnvelop.ymax = REnv.ymax - (Int((REnv.ymax - DEnv.ymax) / CY) * CY) CheckEnvelop.ymin = REnv.ymax - ((Int((REnv.ymax - DEnv.ymin) / CY) + 1) * CY) End Function Public Function GetPolygon() As IGeometry Dim pfws As IFeatureWorkspace Dim pworkspacefactory As IWorkspaceFactory Set pworkspacefactory = New ShapefileWorkspaceFactory Set pfws = pworkspacefactory.openfromfile("d:\gisdata\bjdata", 0) Dim pfeatureclass As IFeatureClass Set pfeatureclass = pfws.openfeatureclass("14_s.shp") Dim pcursor As IFeatureCursor Set pcursor = pfeatureclass.search(nothing, False) Set pfeat = pcursor.nextfeature

28 Dim thegeocol As IGeometryCollection Set GetPolygon = Nothing If pfeat.shape.dimension = esrigeometry2dimension Then Set thegeocol = pfeat.shape If thegeocol.geometrycount = 1 Then Set GetPolygon = thegeocol.geometry(0) End If End If Set pfws = Nothing Exit Function ErrHand: MsgBox "GetPolygon - " & Err.Description End Function Public Function OpenRasterDataset(sPath As String, srastername As String) As IRasterDataset 'Return RasterDataset Object given a file name and its directory On Error GoTo ERH Dim pwsfact As IWorkspaceFactory Dim prasterws As IRasterWorkspace Set pwsfact = New RasterWorkspaceFactory If pwsfact.isworkspace(spath) Then Set prasterws = pwsfact.openfromfile(spath, 0) Set OpenRasterDataset = prasterws.openrasterdataset(srastername) Exit Function Set pwsfact = Nothing End If ERH: MsgBox "Failed in opening raster dataset. " & Err.Description End Function Private Function UsingRasterClassifyColorRampRenderer(pRLayer As IRasterLayer)

29 ' ' We're going to create StatsHistogram Dim praster As IRaster Set praster = prlayer.raster ' 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 = 3 prasren.update ' Create a color ramp to use Dim pramp As IAlgorithmicColorRamp Set pramp = New AlgorithmicColorRamp pramp.size = 3 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.label(i) = "Class" & CStr(i) Next i prasren.update Set prlayer.renderer = pclassren Set praster = Nothing Set prasren = Nothing Set pclassren = Nothing Set pramp = Nothing Set pfsymbol = Nothing End Function Public Function CreateContourFromRaster(sRasterPath As String, srastername As

30 String, strshppath As String, strshpname As String, dinterval As Double, pmap As IMap) Dim prasterdataset As IRasterDataset Set prasterdataset = OpenRasterDataset(sRasterPath, srastername) Dim pshpws As IWorkspace Set pshpws = SetFeatureShapeWorkspace(strShpPath) Dim psurfaceop As ISurfaceOp Set psurfaceop = New RasterSurfaceOp Dim prasteraenv As IRasterAnalysisEnvironment Set prasteraenv = psurfaceop Set prasteraenv.outworkspace = pshpws ' Creates a geodataset to store the results of the operation Dim poutput As IGeoDataset CheckSpatialAnalystLicense Set poutput = psurfaceop.contour(prasterdataset, dinterval) Dim pfeatureclass As IFeatureClass Set pfeatureclass = poutput Dim pflayer As IFeatureLayer Set pflayer = New FeatureLayer Set pflayer.featureclass = pfeatureclass Dim pgeofl As IGeoFeatureLayer Set pgeofl = pflayer pgeofl.displayannotation = True pgeofl.displayfield = "CONTOUR" pmap.addlayer pflayer Dim pda As IDataset Set pda = poutput If pda.canrename Then pda.rename strshpname End If End Function

31 Function DeleteIfExists(sPath, sname As String) ' Create RasterWorkSpaceFactory Dim pwsf As IWorkspaceFactory Set pwsf = New RasterWorkspaceFactory ' Get RasterWorkspace Dim prasterws As IRasterWorkspace If pwsf.isworkspace(spath) Then Set prasterws = pwsf.openfromfile(spath, 0) End If Dim prds As IRasterDataset Set prds = New RasterDataset Set prds = prasterws.openrasterdataset(sname) If Not prds Is Nothing Then Dim pds As IDataset Set pds = prds pds.delete End If End Function 关于 IIdentify 定义时只能找到面而不能找到点和线的问题 编号 : 相关产品及版本 : ArcGIS Engine Developer Kit ArcEngine 平台 : N/A 提交时间 : 修改时间 : 提交人 : 谭军辉 内容摘要 过程描述问题 : 当用定义 IIdentify 时, 用到 Sample 里的当 set pidarray = pidentify.identify(penv) 时, 只能返回面时我们可以修改为 :Dim pidentify As IIdentify Dim pidarray As IArray Dim pfeatidobj As IFeatureIdentifyObj Dim pidobj As IIdentifyObj Set pidentify = frmmdimap.mapcontrol.layer(0)

32 'Convert x and y to map units 'Set ppoint = pactiveview.screendisplay.displaytransformation.tomappoint(x, Y) 'Set pidarray = pidentify.identify(ppoint) '''''''''''''''''''''''''''''''''''''''''''' Dim pdt As IDisplayTransformation Set pdt = pactiveview.screendisplay.displaytransformation Set ppoint = pdt.tomappoint(x, Y) Dim penv As IEnvelope Set penv = ppoint.envelope ' expand the envelope 1/50th of the visible screen width penv.expand (pdt.visiblebounds.width / 50#), _ (pdt.visiblebounds.height / 50#), False Set pidarray = pidentify.identify(penv) '''''''''''''''''''''''''''''''''''''''''''' 'Get the FeatureIdentifyObject If Not pidarray Is Nothing Then Set pfeatidobj = pidarray.element(0) Set pidobj = pfeatidobj pidobj.flash pactiveview.screendisplay 'Report info from FeatureIdentifyObject ' MsgBox "Layer:" & pidobj.layer.name & vbnewline & "Feature:" & pidobj.name Else MsgBox "No feature identified." End If 使用 ArcGIS Engine 来实现地图的点击查询并闪烁 ArcGIS Engine Developer 编号 : 相关产品及版本 : Kit,ArcGIS Engine 平台 : N/A Runtime 9.0 提交时间 : 修改时间 : 提交人 : 朱政 内容摘要 ArcGIS Engine 没有提供在 MapControl 中点击查询的命令, 只是提供了 ReaderControl 中的使用的 点击查询的命令, 下面的代码就是实现点击查询并闪烁的代码

33 过程描述 Private Sub MapControl1_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapx As Double, ByVal mapy As Double) Dim pmap As IMap Dim i As Integer Dim ppoint As IPoint Set pmap = MapControl1.Map Set ppoint = MapControl1.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y) Dim pidentify As IIdentify Dim pidarray As IArray Dim pfeatidobj As IFeatureIdentifyObj Dim pidobj As IIdentifyObj Set pidentify = pmap.layer(1) Dim penv As IEnvelope Set penv = New Envelope Set penv = MapControl1.ActiveView.Extent penv.height = 100 penv.width = 100 penv.centerat ppoint Set pidarray = pidentify.identify(penv) If Not pidarray Is Nothing Then Set pfeatidobj = pidarray.element(0) Set pidobj = pfeatidobj pidobj.flash MapControl1.ActiveView.ScreenDisplay ' 消息显示查询目标的信息 MsgBox "Layer:" & pidobj.layer.name & vbnewline & "Feature:" & pidobj.name Else MsgBox "No feature identified." End If End Sub

34 空间查询的实现 ArcGIS Engine Developer 编号 : 相关产品及版本 : Kit,ArcGIS Engine 平台 : N/A Runtime 9.0 提交时间 : 修改时间 : 提交人 : 朱政内容摘要空间查询是一个经常要用到的功能, 它是通过给定一定的范围, 查询得到在这个空间范围内的要素的查询方式 下面的代码是在返回鼠标点击点周围长宽 100 个地图单位的矩形范围内的要素 过程描述 Dim pmap As IMap Dim ppoint As IPoint Set pmap = MapControl1.Map Dim pfeaturelayer As IFeatureLayer Set pfeaturelayer = pmap.layer(1) Set ppoint = MapControl1.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y) Dim penv As IEnvelope Set penv = New Envelope Set penv = MapControl1.ActiveView.Extent penv.height = 100 penv.width = 100 penv.centerat ppoint MsgBox ppoint.x MsgBox penv.xmax Dim pgeometry As IGeometry Set pgeometry = penv Set pgeometry.spatialreference = pmap.spatialreference pfeaturelayer.selectable = True Dim psfilter As ISpatialFilter Set psfilter = New SpatialFilter With psfilter Set.Geometry = pgeometry.geometryfield = pfeaturelayer.featureclass.shapefieldname

35 .SpatialRel = esrispatialrelintersects End With Dim b As Boolean b = psfilter.filterownsgeometry Dim pfeaturecursor As IFeatureCursor Set pfeaturecursor = pfeaturelayer.search(psfilter, False) 如何在同一图层中做缓冲选择 编号 : 相关产品及版本 : ArcIMS ArcIMS 平台 : N/A 提交时间 : 修改时间 : 提交人 : 张在荣内容摘要在 javaconnector 中如何在同个图层中缓冲并选择要素 在同一图层中选择出缓冲分析结果需要额外的步骤才能完成, 但是当选择图层和做缓冲的不是同一层时, 则不需要额外的步骤 一个典型的查询例子是这样的 : 在 San Jose 市周围 8 公里内有多少城市? 过程描述步骤 : 额外的步骤如下, 需要创建一个新的层来用作 buffer 层 在 filter 选择中, 如果 buffer 层和选择目标层是同一层时, 将导致错误结果产生 1. 创建一个连接并初始化一个 Map 对象 在 Map.initMap() 中 LaodRecordset 属性必须设置为 true map.initmap(connection,0,false,false,true,false); 2. 创建 buffer 层的引用 FeatureLayer flayer = (FeatureLayer)map.getLayers().item(5); //buffer layer 3. 创建一个 buffer 层的复制层来作为选择的目标层 该新的复制层和原来的图层具有相同的 LayerID,MaxScale,MinScale, 和 Recordset FeatureLayer tlayer = new FeatureLayer(fLayer.getID(),fLayer.getMaxScale(),fLayer.getMinScale()); tlayer.setrecordset(flayer.getrecordset()); //tlayer is the target layer 4. 创建 Filter 类和 Buffer 对象, 并设置他们的属性应用到 buffer 层上 Filter filter = new Filter(); filter.setwhereexpression("name='san Jose'"); Buffer buffer=new Buffer(); buffer.setbufferunits(buffer.miles); buffer.setbufferdistance(8); buffer.setperformbuffer(true); buffer.setbufferregionsymbol(ps); buffer.setbufferselectionsymbol(ms); buffer.setbuffertargetlayer(tlayer); filter.setbufferobject(buffer);

36 flayer.setfilterobject(filter); 5. 查询结果被保存在一个名称为 'bufferlayer' 的层中 FeatureLayer resultlayer=null; Recordset recordset = null; for (int i=0;i<map.getlayers().getcount();i++){ if (map.getlayers().item(i).getname().equalsignorecase("bufferlayer")){ resultlayer = (FeatureLayer)map.getLayers().item(i); break; } } 怎么样使用 Engine 来保存 Mxd 文件 ( 几种情况 )? 编号 : 相关产品及版本 : ArcGIS Engine Developer Kit,ArcGIS Engine Runtime 9.x 平台 : N/A 提交时间 : 修改时间 : 提交人 : 朱政内容摘要 ArcGIS Engine 提供了保存 Mxd 文件的类 MapDoment 但在具体保存 MXD 文件过程中有下面几种情况 : 1 直接使用 IMapDocument 接口的 Open 方法来打开 MXD 文件, 编辑过后进行保存 2 使用 Engine 中带的 OpenDocument 方法来打开 MXD 文件, 然后编辑过之后要进行保存 3 使用自己写的添加数据的工具直接添加数据, 也就是说一开始没有 MXD 文件, 在编辑完之后需要把当前的地图保存为一个 MXD 文件 过程描述解决方法 : 首先这三种情况都可以使用 Engine 中自带的 SaveDoument 的工具进行保存 1 这种情况比较简单, 直接使用 IMapDocument 的 save 或者 saveas 的方法来进行保存就可以, 可以在帮助中查到例子 2 这种情况可使用下面的代码 (c# 语言 ) 进行保存, IMxdContents pmxdc; pmxdc = axmapcontrol1.map as IMxdContents ; IMapDocument pmapdocument = new MapDocumentClass(); pmapdocument.open (axmapcontrol1.documentfilename,""); IActiveView pactiveview = axmapcontrol1.map as IActiveView ; pmapdocument.replacecontents (pmxdc); pmapdocument.saveas ("d:\aa2.mxd",true,true); 3 这种情况使用的代码 (c# 语言 ) 稍微有点不同 : IMxdContents pmxdc; pmxdc = axmapcontrol1.map as IMxdContents ; IMapDocument pmapdocument = new MapDocumentClass (); pmapdocument.new ("d:\aa3.mxd");

37 IActiveView pactiveview = axmapcontrol1.map as IActiveView ; pmapdocument.replacecontents (pmxdc); pmapdocument.save (true,true); 在 ArcGIS Engine 开发时如何改变标注字段 编号 : 相关产品及版本 : ArcGIS Engine Developer Kit,ArcGIS Engine Runtime 9.0 平台 : N/A 提交时间 : 修改时间 : 提交人 : 朱政内容摘要在 ArcGIS Engine 开发应用程序做标注时, 用某一个字段来标注是非常常见的功能, 下面的代码说明的是如何来动态的改变标注的字段 过程描述 ' 假设 pflayer 是一个有效的 FeatureLayer 对象, 下面这两句代码是用默认的字段来标注 pflayer.displayfield = "FID" pflayer.displayannotation = True ' 假设 pglayer 是一个有效的 GeoFeatureLayer 对象, 下面的代码是把标注字段改为要素类的中第四个字段 ' 注意 : 通过 pflayer.displayfield 属性来改变标注字段是无效的 Dim pannolayerpropscoll As IAnnotateLayerPropertiesCollection Set pannolayerpropscoll = pglayer.annotationproperties pannolayerpropscoll.clear ' 创建一个新的 LabelEngineLayerProperties 对象 Dim alelayerprops As ILabelEngineLayerProperties Set alelayerprops = New LabelEngineLayerProperties alelayerprops.isexpressionsimple = True alelayerprops.expression = "[" & pflayer.featureclass.fields.field(3).name & "]" pannolayerpropscoll.add alelayerprops ' 刷新 MapControl1.ActiveView.PartialRefresh esriviewgeography + esriviewgraphics, Nothing, Nothing

38 对 shape 文件添加字段 编号 : 相关产品及版本 : MapObjects-Windows 2.2 平台 : PC-Intel Windows2000 提交时间 : 修改时间 : 提交人 : 谭军辉内容摘要要求 : 只能对非加载的 shape 进行操作, 对于加的, 必须移除, 并且与该层相关的对象必须清空过程描述 Public Sub FieldAppender(dbPath As String, _ Filename As String, _ newfldname As String, _ NewFldType As String, _ newfldsize As Integer) Dim db As Database Dim tdf1 As TableDef, tdf2 As TableDef Dim ndx1 As Index, ndx2 As Index Dim fld1 As DAO.Field, fld2 As DAO.Field Dim sql As String Set db = OpenDatabase(dbPath, False, False, "dbase IV;") Debug.Print db.updatable Dim i As Integer For i = 0 To db.tabledefs.count - 1 If db.tabledefs(i).name = Filename Then Set tdf1 = db.tabledefs(filename) End If DoEvents Next i If tdf1 Is Nothing Then MsgBox " 没有找到该 shapefile 文件 ", vbokonly Exit Sub End If For i = 0 To db.tabledefs.count - 1 If db.tabledefs(i).name = "SHENYU" Then sql = "Drop Table Shenyu" db.execute sql End If DoEvents Next i

39 Set tdf2 = New TableDef tdf2.name = "Shenyu" For Each fld1 In tdf1.fields Set fld2 = New DAO.Field fld2.name = fld1.name fld2.type = fld1.type fld2.size = fld1.size tdf2.fields.append fld2 DoEvents Next fld1 Set fld2 = New DAO.Field fld2.name = newfldname fld2.type = NewFldType fld2.size = newfldsize tdf2.fields.append fld2 db.tabledefs.append tdf2 sql = "Insert into Shenyu Select * from " & Filename db.execute sql Set tdf1 = Nothing sql = "Drop Table " & Filename db.execute sql tdf2.name = Filename db.close Set db = Nothing Exit Sub ErrorHandler: db.close Set db = Nothing Exit Sub End Sub

40 在 ArcGisEngine 开发中如何在 Toolbar 控件上添加 Combobox 等其他控件 编号 : 相关产品及版本 : ArcGIS Engine Developer Kit 8.x 9.x 平台 : N/A 提交时间 : 修改时间 : 提交人 : 董杰内容摘要如果在 ESRI 的 Toolbar 控件上添加一个 Combobox 需要在 Command 类中实现 IToolControl 接口在将指定控件的句柄做为 IToolControl.hwnd 返回即可过程描述 public class MyCombobox:BaseCommand,IToolControl { private int _handle=0; private ICompletionNotify _CompNotify; public MyCombobox(int handle) { _handle = handle; } public override void OnCreate(object hook) { // TODO: 添加 SymbolType.OnCreate 实现 } #region IToolControl 成员 public int hwnd { get { // TODO: 添加 SymbolType.hWnd getter 实现 return _handle; } } public void OnFocus(ICompletionNotify complete) { _CompNotify = complete; // TODO: 添加 SymbolType.OnFocus 实现

41 } public bool OnDrop(ESRI.ArcGIS.SystemUI.esriCmdBarType bartype) { // TODO: 添加 SymbolType.OnDrop 实现 if (bartype == esricmdbartype.esricmdbartypetoolbar ) { return true; } else return false; } #endregion } 自相交对象的处理 编号 : ArcGIS Engine Developer 相关产品及版本 : Kit,ArcGIS Engine Runtime,ArcGIS Server 9.1 平台 : PC-Intel Windows2000 提交时间 : 修改时间 : 提交人 : 黄齐飞内容摘要很多线划图数据进 ArcSDE 库中都会有些对象转换不进去 这些对象有很大一部分是由于数据本身有自相交的情况 如果这些线划图数据只是用来做底图, 而不需要做对象分析 则可以采用数据简单化操作后再转换入 ArcSDE 中 具体操作如下例子 : 过程描述 Private Sub SimplifyPolyLine(pPolyline As esrigeometry.polyline) ' 通过 QI 取得线对象的拓扑操作接口 Dim ptopologicaloperator As esrigeometry.itopologicaloperator Set ptopologicaloperator = ppolyline ' 执行简单化操作 ptopologicaloperator.simplify ' 简单化操作完了的数据可以转换入 ArcSDE 中了 ' 下面代码用来展示简单化后的线数据的每个部分 Dim pgeometrycollection As esrigeometry.igeometrycollection Set pgeometrycollection = ppolyline

42 Dim i As Long For i = 0 To pgeometrycollection.geometrycount - 1 Dim TempPolyline As esrigeometry.igeometrycollection Dim TempPath As esrigeometry.ipath Set TempPolyline = New esrigeometry.polyline Set TempPath = pgeometrycollection.geometry(i) TempPolyline.AddGeometry TempPath MapControl1.FlashShape TempPolyline Set TempPath = Nothing Set TempPolyline = Nothing Next i End Sub 在图中加入采集点 ArcInfo 编号 : 相关产品及版本 : Desktop,ArcEditor,ArcView,ArcGIS Extension 9 平台 : N/A 提交时间 : 修改时间 : 提交人 : 沈百玲 内容摘要 我在野外采集了数据, 是用 GPS 定位的, 请问如何将其加入地图中, 另外, 我的数据是度分秒的, 是否需要转换为十进制, 请问如何转换 将其加入地图之前, 是否需要先将地图进行投影, 如果投影, 我们是需要投影为西安 80 还是北京 54 坐标系? 过程描述如果你的数据保存成文本文件了, 你可以用 Coverage 的转换工具中的 Generate 工具, 将文本文件转成相应的点 线 面数据 Generate 工具的文本文件有一定的格式, 请参考相关的帮助说明 如果你的数据保存在表 (dbase info access 等 ), 可以在 ArcMap 中 tools 菜单下通过 "Add XY data" 向导工具指定 X 和 Y 字段后添加到 ArcMap 中并保存成 Shapefile 或 geodatabase

43 另外, 可以采用 ArcGIS 9 的 Data Interoperability 扩展模块通过自定义数据格式和转换工具来导入 gps 数据 数据导入之前, 坐标单位必须是小数度的方式, 如果是度分秒的,ESRI 不提供工具转换, 需要用户自己计算转换成小数度格式 关于投影, 可以有, 也可以没有 如果原来的地图已经有投影的话, 在 ArcMap 中会动态给数据投影的 具体采用哪种投影方式是根据用户自己已有的数据来决定的 创建拓扑类 投影等等 编号 : 相关产品及版本 : ArcInfo Desktop 9 平台 : PC-Intel WindowsXP 提交时间 : 修改时间 : 提交人 : 赵万锋 内容摘要 在 arccatolog 中创建拓扑类的详细步骤 另外, 还有这样如下问题 : 如何能知道当前地图是否经过投影 ; 求详细的投影变换方面的知识, 包括 80 和 54 坐标系的关系, 以及如何进行投影变换 投影变换的用途和意义等等 ; 我在野外采了好多点, 是用 GPS 定位的, 请问如何将这些点及它们的属性做到图上? 过程描述关于创建拓扑 : 对于 ArcGIS 而言, 能为包含在要素集中的一个或多个要素类定义拓扑 它可以为点 线 面和多边形要素定义拓扑 拓扑是一系列用于空间关系的完整规则 有一些重要的属性 : 一个群组容限 (cluster tolerance) 要素类等级( 对坐标精度而言 ) 错误( 违规 ) 和你所订定义的规则的任何异常情况 ArcInfo 包含了一个拓扑向导来选择参与拓扑的要素类, 并定义它们的属性 创建拓扑的步骤如下 : 1. 打开 ArcCalalog, 右击一个 featuredataset, 在弹出的菜单中选择 New>Topology, 点击下一步 2. 在接下来的步骤中输入拓扑类的名称, 并输入一个容限值 容限是一个距离范围, 在这个范围内节点被认为是重叠的 在拓扑验证过程中, 落入群组容限的节点和端点会被捕捉 3. 点击下一步, 选择参与拓扑的 featureclass 4. 点击下一步, 可以为每一个 featureclass 输入等级, 等级低的会被捕捉到等级高的 featureclass 中去 ( 等级越高, 越不会被移动 ) 5. 点击下一步, 可以为拓扑增加拓扑规则 拓扑规则可以为一个要素中的要素定义, 也可以为两个

44 或两个以上要素类间的要素定义 比如规则包括 : 多边形不能重叠 ; 不能有悬线 (dangle); 点必须在多边形边界内 ; 多边形不能有间隙 ; 线不能相交 ; 点必须放置到端点 拓扑规则同样能为要素类的子类 (subtype) 定义 6. 最后点击完成, 验证拓扑 关于地图投影 : 要知道地图是否经过投影, 最好是询问地图的来源处, 这是最好的途径 你也可以给地图定义你所需的投影 ( 如果地图没有定义投影的话 ), 然后在 ArcMap 中显示, 观察标志点的坐标, 如果坐标明显不对, 那么原地图是没有经过投影的, 或者是投影不对的 关于西安 80 和北京 54, 它们只是大地水准面不同而已, 这方面的知识网上资料很多, 可以去查找一下 关于投影变换 : 可以到 ArcToolbox 的 Data Manager Tools 下的 Feature 或 Raster 下面的 Project 工具来变换 在投影变换前, 原地图必须经过投影, 而且已经加上了投影定义 投影变换的用途和意义请查看相关资料 关于 GPS 采集点 : 可以把采集的数据放到一个 dbf 表格中, 然后打开 ArcCatalog, 右键点击表格, 选择 Create Feature Class>From XY Table 在向导对话框中选择 X 坐标字段,Y 坐标字段和保存位置即可 如何解决 shapefile 和 coverage 出现无法导入 SDE 数据库现 象? 编号 : 相关产品及版本 : ArcInfo Desktop 9.0,9.1 平台 : N/A 提交时间 : 修改时间 : 提交人 : 许春杰问题 shapefile 和 coverage 出现无法导入 SDE 数据库, 导入过程中出现,Underlying DBMS error, ORA-00911: 无效字符错误 出现该错误的原因是源文件的字段名中出现了像 $,# 等无效字符 解答在 SDE 中新建一个 FEATURE CLASS, 然后将源数据的 SPATAIL REFERENCE 导入, 将字段定义也导入, 导入字段定义的时候你可以修改字段, 去掉 " $" 之类不规则的字符 建完 FEATURE CLASS 后再右键点击您的要素类, 选择 LOAD DADA, 选择源 SHAPE 文件或者源 CONVERAGE, 会出来对话框如何进行字段映射, 设置完成后即可将数据导入

45 怎么显示布局控件的标尺 ArcGIS Engine 编号 : 相关产品及版本 : Developer Kit 2000 平台 : PC-Intel Windows2000 提交时间 : 修改时间 : 提交人 : 黄齐飞内容摘要使用如下代码在 ArcEngine 中显示不出来布局控件的标尺 : Private Sub Command1_Click() PageLayoutControl1.PageLayout.RulerSettings.SmallestDivision = 2 PageLayoutControl1.ActiveView.ShowRulers = True PageLayoutControl1.Refresh End Sub 过程描述在 ArcEngine 中没有标尺对象 可以使用 VC++ 编写 把 shapefile polygons 转为 polylines ArcInfo 编号 : 相关产品及版本 : Desktop,ArcEditor,ArcView 8.x, 平台 : 9.0 PC-Intel Windows 提交时间 : 修改时间 : 提交人 : 朱华岚 内容摘要 本文显示了如何在 ArcCatalog 和 ArcMap 中把 shapefile 的 polygon 边界转为 polyline 过程描述

46 1. 在 ArcCatalog 中创建一个新的 polyline shapefile 2. 在 ArcMap 中添加 polygon shapefile 和新的 polyline shapefile 3. 在 Editor 工具栏中选择 Start Editing 4. 把 Task 设为 Create New Feature, 把 Target 设为新建的 polyline shapefile 5. 在 polygon shapefile 的上下文菜单中单击 Select All 6. 在 ArcMap 的 Edit 的菜单中选择 Copy 命令, 或者按 Ctrl+C 7. 在 ArcMap 的 Edit 的菜单中选择 Paste 命令, 或者按 Ctrl+V 8. 保存编辑 注意 : 使用这种方法属性数据不会在 polygons 和 polylines 间转换 为什么不能编辑 raster 属性表或添加字段? 编号 : 相关产品及版本 : ArcInfo 平台 : Desktop,ArcEditor 8.1,8.2,8.3,9.0 PC-Intel Windows 提交时间 : 修改时间 : 提交人 : 林雪淋 问题为什么不能编辑 raster 属性表或添加字段? 解答 ArcGIS 8.x 和 9.x 不支持编辑 raster 表或为 raster 表添加字段 因此, 当打开一个 raster 属性表, 在编辑工 具里面的开始编辑选项是灰色不可用的, 同样的在 raster 属性表选项采单中添加字段选项也是不可用的 对于 grids 的编辑属性表,ArcInfo Workstation 或 ArcView 3.x 可以用 第二种方法是利用 ArcObjects 编程来做, 包括 add a field to the GRID VAT,"delete a field from the GRID VAT", 或 "update the VAT". 更多的信息请阅读 ArcObjects, 请参考 里边的 DataSourcesRaster 库是这个主题的好资源 如果仅仅是为了显示, 那么可以通过以下步骤添加字段到 raster 层的属性表 : 1 右击 ArcMap 内容表中的 raster 层 2 指向 Joins and Relates 3 点 Join 4 根据对话框的向导完成

47 使用 ArcGIS 将 GTOPO30 DEM 数据转换到栅格数据 编号 : 相关产品及版本 : ArcInfo Desktop 8.2, 8.3, 平台 : 9.0 N/A 提交时间 : 修改时间 : 提交人 : 文杰内容摘要可以使用 ArcGIS Spatial Analyst( 空间分析 ) 功能将美国地质勘探 (USGS)GTOPO30 数字高程模型 (DEM) 转化为 ESRI 栅格格式 在相关信息部分点击 USGS GTOPO30 链接来下载 GTOPO30 DEM 数据 这个文件后缀名是.tar, 包括了.dem 和.hdr 文件 这两种文件都要进行如下操作过程描述 1. 用 WinZip 解压缩 TAR 文件 2. 将 *.dem 后缀名改为 *.bil. 3. 打开 ArcCatalog. 4. 指向第二步生成的 *.bil. 文件 5. 右击 *.bil. 选择输出 >Raster to Different Format. 指定你想保存新的栅格数据的位置, 确保存储类型被设置为 ESRI GRID 6. 打开 ArcMap 并且添加第 5 步生成的栅格数据 7. 在 ArcGIS Spatial Analyst 工具条里面点击 Spatial Analyst, 然后选择 Options. 8. 点击 General tab 设置工作文件夹 9. 点击 Extent tab 设置 analysis extent 为 Same as layer your grid 10. 点击 Cell Size 设置 Analysis cell 为 Same as layer your grid, 然后点击 OK 11. 回到 ArcGIS Spatial Analyst, 然后选择 Raster Calculator. 输入以下的表达式, 代替 [in_grid] 为 your grid. 包括中括号. CON([in_grid] >= 32768,[in_grid] ,[in_grid]) 点击 Evaluate. 12. 使用 SETNULL 功能可以将海洋区域 (-9999) 转换为 NODATA, 插入以下语句, 用上一步生成的结果替换 [Calculation]. 包括中括号. setnull([calculation ] == -9999, [Calculation ]) 点击 Evaluate. 13. 在 Calculation 结果处点击右键选择 Make Permanent 将最后输出结果保存到硬盘. 旋转地图 ArcInfo Desktop,ArcGIS 编号 : Engine Developer 相关产品及版本 : Kit,ArcGIS Engine Runtime 9.1 平台 : PC-Intel Windows 提交时间 : 修改时间 : 提交人 : 黄齐飞

48 内容摘要旋转当前的地图 过程描述使用 IScreenDispaly::RotateStart 接口来实现旋转地图功能 代码如下 : Add a UIToolControl to any toolbar. Paste this code in for the control. Make sure the names match. Load some data and zoom into a desired location. Select the UIToolControl. As you drag an arc on the focus map, the focus map rotates. Release the mouse to set the final rotation angle. Option Explicit Private m_pmxdoc As IMxDocument Private m_pactiveview As IActiveView Private m_pscreendisplay As IScreenDisplay Private m_brotating As Boolean Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long) Dim penv As IEnvelope Dim pcenterpoint As IPoint Dim ptransform As IDisplayTransformation Set m_pmxdoc = Application.Document Set m_pactiveview = m_pmxdoc.focusmap Set m_pscreendisplay = m_pactiveview.screendisplay 'Rotate around the display's center point Set ptransform = m_pscreendisplay.displaytransformation Set penv = ptransform.fittedbounds Set pcenterpoint = New Point pcenterpoint.putcoords ((penv.xmax + penv.xmin) / 2), ((penv.ymax + penv.ymin) / 2) 'Start the rotation m_pscreendisplay.rotatestart m_pmxdoc.currentlocation, pcenterpoint m_brotating = True End Sub Private Sub UIToolControl1_MouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As

49 Long, ByVal y As Long) If Not button = 1 Then Exit Sub If Not m_brotating Then Exit Sub 'Update rotation m_pscreendisplay.rotatemoveto m_pmxdoc.currentlocation m_pscreendisplay.rotatetimer End Sub Private Sub UIToolControl1_MouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long) Dim drotationangle As Double If Not button = 1 Then Exit Sub 'Complete the rotation and refresh the diplay m_brotating = False drotationangle = m_pscreendisplay.rotatestop m_pscreendisplay.displaytransformation.rotation = drotationangle m_pactiveview.refresh End Sub 给 geodatabase 或 shapefile 定义一个投影 ArcInfo 编号 : 相关产品及版本 : Desktop,ArcEditor,ArcView 8.x, 平台 : N/A 9.0 提交时间 : 修改时间 : 提交人 : 吴乐茂 内容摘要 本文描述如何利用 ArcToolBox 给 geodatabase 或 shapefile 定义一个自己的投影 给数据集定义投影是使用 ArcGIS 的十分重要的一部分 尽管可以利用未定义投影的数据进行工作, 但如果未事先定义一个投影, 对于具有不同投影的各种数据将无法进行正确叠加 此外, 如果数据未定义好投影, 某些分析工具将无法得到精确的的分析结果 定义投影不同于投影数据 定义投影仅是提供 ArcGIS 为正确显示和处理数据所需要的信息 给数据集定义投影并不改变数据本身的坐标 注 : 对于 ArcGIS, 术语 坐标系统 和 投影 经常可以通用 精确地讲, 给数据定义一个坐标系统十分重要 一个坐标系统可以 ( 但不总是 ) 包含投影信息 过程描述

50 ArcGIS Engine 中 Undo Redo 命令的使用 ArcGIS Engine Developer 编号 : 相关产品及版本 : Kit,ArcGIS Engine 平台 : N/A Runtime 9.0 提交时间 : 修改时间 : 提交人 : 朱政内容摘要 ArcGIS Engine 产品可以对于存储在大型数据库中的地理数据进行编辑, 而且对于注册过版本和没有注册过版本的数据都可以进行各种编辑的操作 只是注册过版本的数据需要在一个编辑会话 (starteding...stopediting) 才能进行编辑 过程描述 ArcGIS Engine 没有提供的各种编辑工具, 但是提供了 Undo Redo 的命令, 但是只有在对注册过版本的表进行编辑时才可以使用这两个命令 创建带 Z 值的 Feature 编号 : ArcInfo Desktop,ArcGIS 相关产品及版本 : Engine Developer Kit,ArcGIS Engine Runtime 90 平台 : PC-Intel Windows2000 提交时间 : 修改时间 : 提交人 : 黄齐飞内容摘要使用 IZAware 接口, 对 Feature 设置 Z 值 例子中构建了三个点的多边形 测试条件 : 建立一个 Test.mdb 的 PGDB, 创建一个有 Z 值的多边形图层 加载图层, 运行程序 过程描述 Option Explicit Dim paoinitialize As esrisystem.iaoinitialize Dim pworkspace As esrigeodatabase.iworkspace Dim Pt1 As esrigeometry.ipoint Dim Pt2 As esrigeometry.ipoint Dim Pt3 As esrigeometry.ipoint Dim pptc As esrigeometry.ipointcollection

51 Private Sub Form_Load() ' 许可初始化 Set paoinitialize = New AoInitialize If paoinitialize Is Nothing Then MsgBox " 不能初始化, 程序退出!" Unload Me End End If If paoinitialize.isproductcodeavailable(esrilicenseproductcodeenginegeodb) = esrilicenseavailable Then Else MsgBox " 没有合适的运行许可, 退出程序!" Unload Me End End If ' 加载数据 Dim pworkspacefactory As esrigeodatabase.iworkspacefactory Set pworkspacefactory = New esridatasourcesgdb.accessworkspacefactory Set pworkspace = pworkspacefactory.openfromfile(app.path & "test.mdb", 0) Dim pfeatureworkspace As esrigeodatabase.ifeatureworkspace Dim pfeatureclass As esrigeodatabase.ifeatureclass Dim pfeaturelayer As esricarto.ifeaturelayer Set pfeatureworkspace = pworkspace Set pfeatureclass = pfeatureworkspace.openfeatureclass("afeitest") Set pfeaturelayer = New esricarto.featurelayer Set pfeaturelayer.featureclass = pfeatureclass MapControl1.AddLayer pfeaturelayer Set pfeatureclass = Nothing Set pfeatureclass = pfeatureworkspace.openfeatureclass("afeitestpolygon") Set pfeaturelayer = New esricarto.featurelayer Set pfeaturelayer.featureclass = pfeatureclass MapControl1.AddLayer pfeaturelayer Set pfeatureclass = Nothing End Sub Private Sub Form_Unload(Cancel As Integer)

52 paoinitialize.shutdown End Sub Private Sub MapControl1_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapx As Double, ByVal mapy As Double) Dim Pt As esrigeometry.ipoint Set Pt = MapControl1.ToMapPoint(x, y) Pt.Z = 10 Dim pptzaware As esrigeometry.izaware Set pptzaware = Pt With pptzaware.zaware = True End With If Pt1 Is Nothing Then Set Pt1 = Pt ElseIf Pt2 Is Nothing Then Set Pt2 = Pt Else Set Pt3 = Pt Set pptc = New esrigeometry.polygon Dim pptczaware As esrigeometry.izaware Set pptczaware = pptc With pptczaware.zaware = True End With pptc.addpoint Pt1 pptc.addpoint Pt2 pptc.addpoint Pt3 pptc.addpoint Pt1 Dim pfeaturelayer As esricarto.ifeaturelayer Dim pfeatureclass As esrigeodatabase.ifeatureclass Dim pworkspaceedit As esrigeodatabase.iworkspaceedit Set pfeaturelayer = MapControl1.Layer(0) Set pfeatureclass = pfeaturelayer.featureclass Set pworkspaceedit = pworkspace pworkspaceedit.startediting True

53 pworkspaceedit.starteditoperation Dim pfeature As esrigeodatabase.ifeature Set pfeature = pfeatureclass.createfeature With pfeature Set.Shape = pptc.store End With pworkspaceedit.stopeditoperation pworkspaceedit.stopediting True MapControl1.Refresh Set Pt1 = Nothing Set Pt2 = Nothing Set Pt3 = Nothing Set pptczaware = Nothing Set pptc = Nothing End If Set pptzaware = Nothing Set Pt = Nothing End Sub 在 Ao 中如何通过查询获得 ITable 编号 : 相关产品及版本 : ArcGIS Engine Developer Kit 8.x, 9.x 平台 : N/A 提交时间 : 修改时间 : 提交人 : 董杰内容摘要在 Ao 调用中可以使用 Sql 查询获得的 ITable 接口的实例如何实现参数如何设置过程描述 C# public static ITable OpenDBQuery(IFeatureWorkspace fw,string SubFields,string Tables,string WhereClause,string PrimaryKey,string OutName)

54 { IQueryDef qd = fw.createquerydef() ; qd.subfields =SubFields; qd.tables = Tables; qd.whereclause = WhereClause; IQueryName2 qn = new TableQueryNameClass(); // 1 设置了 PrimaryKey 作为 FeatureClass 主键 CopyLocally 参数失效 // 2 如果使用简单查询并且结果中包含主键将自动作为 PrimaryKey CopyLocally 参数失效 // 3 其他情况下 CopyLocally 为 true 将数据复制到本地自动加入 OID 字段,false 将直接连接数据源没有 OID // 主健字段如果为单数字型字段将直接使用 // 如为多字段或字符型将创建两个内存表 (OID-PrimK)(PrimK-OID) 如果数据量较大时将占用虚拟内存 // 如果不设主键设置 CopyLocally = true 将在 temp 目录下建立零时 PGDB // 字段名成可能有所改变 (A.field1-> A_field1) 但字段别名不变且具有 OID if (PrimaryKey!="") { qn.primarykey = PrimaryKey; } qn.copylocally = true; qn.querydef = qd; IDataset ds = fw as IDataset; IWorkspaceName wn= ds.fullname as IWorkspaceName; IDatasetName dn = qn as IDatasetName; dn.workspacename = wn; dn.name=outname; IName n = qn as IName; ITable t = n.open() as ITable; return t; } 关于多个实体联合 (union) 的使用 ArcInfo 编号 : Desktop,ArcEditor,ArcView,ArcGIS 相关产品及版本 : Engine Developer Kit,ArcGIS Server 平台 : N/A 提交时间 : 修改时间 : 提交人 : 谭军辉 内容摘要 实现多个实体的联合, 通过这种联合可以与其他几何实体进行空间关系判断, 请看如下实例

55 过程描述 '''''''''''''''''''''''''''''''''''''''''''''''' dim I as interger Dim SelectFeatureLineArr is Iarray Set SelectFeatureLineArr = new Array 加入实体到 array 中, 之后 Dim ptmpgeom As IGeometry Dim pgeom As IGeometry Dim poutputgeometry As IGeometry Dim ptopooperator As ItopologicalOperator Dim lfeature As ifeature For i = 0 To SelectFeatureLineArr.Count - 1 Set lfeature = SelectFeatureLineArr.Element(i) Set pgeom = lfeature.shapecopy If i = 0 Then ' if its the first feature Set ptmpgeom = pgeom Set poutputgeometry = ptmpgeom Else ' merge the geometry of the features Set ptopooperator = ptmpgeom Set poutputgeometry = ptopooperator.union(pgeom) Set ptmpgeom = poutputgeometry End If Next i 在 Ao 中如何通过查询获得 ITable 编号 : 相关产品及版本 : ArcGIS Engine Developer Kit 8.x, 9.x 平台 : N/A 提交时间 : 修改时间 : 提交人 : 董杰内容摘要在 Ao 调用中可以使用 Sql 查询获得的 ITable 接口的实例如何实现参数如何设置过程描述 C# public static ITable OpenDBQuery(IFeatureWorkspace fw,string SubFields,string Tables,string WhereClause,string PrimaryKey,string OutName) {

56 IQueryDef qd = fw.createquerydef() ; qd.subfields =SubFields; qd.tables = Tables; qd.whereclause = WhereClause; IQueryName2 qn = new TableQueryNameClass(); // 1 设置了 PrimaryKey 作为 FeatureClass 主键 CopyLocally 参数失效 // 2 如果使用简单查询并且结果中包含主键将自动作为 PrimaryKey CopyLocally 参数失效 // 3 其他情况下 CopyLocally 为 true 将数据复制到本地自动加入 OID 字段,false 将直接连接数据源没有 OID // 主健字段如果为单数字型字段将直接使用 // 如为多字段或字符型将创建两个内存表 (OID-PrimK)(PrimK-OID) 如果数据量较大时将占用虚拟内存 // 如果不设主键设置 CopyLocally = true 将在 temp 目录下建立零时 PGDB // 字段名成可能有所改变 (A.field1-> A_field1) 但字段别名不变且具有 OID if (PrimaryKey!="") { qn.primarykey = PrimaryKey; } qn.copylocally = true; qn.querydef = qd; IDataset ds = fw as IDataset; IWorkspaceName wn= ds.fullname as IWorkspaceName; IDatasetName dn = qn as IDatasetName; dn.workspacename = wn; dn.name=outname; IName n = qn as IName; ITable t = n.open() as ITable; return t; } 在 Visual Basic 中实现 ICommand 接口 编号 : 相关产品及版本 : ArcInfo Desktop,ArcEditor,ArcView 8.3,9.0 平台 : N/A 提交时间 : 修改时间 : 提交人 : 朱政 内容摘要 在 dll 中创建自定义的命令和工具, 需要实现 ICommand 接口, 下面就是实现 Icommand 接口的过 程描述 过程描述

57 1 创建一个 Visual Basic ActiveX DLL 工程 ; 命名类名称为 'clsmycommand' 命名工程名称为 'AoDeomo' 2 在常规声明段, 输入 Implements ICommand 3 在代码窗口, 使用对象下拉列表 ( 左边 ), 选择 Icommand; 4 在代码窗口, 使用功能下拉列表, 选择 ICommand 的的成员 ; 5 为 Caption 属性写实现代码 ; Private Property Get ICommand_Caption() As String ICommand_Caption = "MyCommand" End Property 6 为 Category 属性写实现代码 ; Private Property Get ICommand_Category() As String ICommand_Category = "ArcObjects Custom Commands" End Property 7 为 Check 属性写实现代码 ; Private Property Get ICommand_Checked() As Boolean ICommand_Checked = False End Property 注意 :false 表示处于非恩下状态 8 为 Enabled 属性写实现代码 ; Private Property Get ICommand_Enabled() As Boolean ICommand_Enabled = True End Property 注意 : 当 Enabled 属性设为真, 用户可以能使用这个按钮 9 为 HelpContextID 属性写实现代码 Private Property Get ICommand_HelpContextID() As Long ICommand_HelpContextID = 0 End Property 注意 :0 表示没有自定义的帮助 10 为 HelpFile 属性写实现代码 ; Private Property Get ICommand_HelpFile() As Long ICommand_HelpFile = "" End Property 注意 : 使用 0 长度的字符串表示没有自定义的帮助文件 11 为 Message 属性写实现代码 Private Property Get ICommand_Message() As String ICommand_Message = "MyCommand" End Property 注意 : 这个字符串会在 arcmap 的状态栏中出现 12 为 Name 属性写实现代码 ; Private Property Get ICommand_Name() As String ICommand_Name = "MyCommand" End Property

58 13 为 Tooltip 属性写实现代码 ; Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = "Tooltip: MyCommand" End Property 注意 : 这个字符串会在鼠标移动到按钮上时提示 14 在常规申明段, 加上下面两句, 这是关系到此命令在 arcmap 中的使用的 Option Explicit Private m_papp As IApplication Implements ICommand 15 在 OnCreate 方法中, 传递 hook 到应用程序 ; Private Sub ICommand_OnCreate(ByVal hook As Object) Set m_papp = hook End Sub 16 当按钮被点击时执行的代码写在 OnClick 事件中 ; Private Sub ICommand_OnClick() MsgBox "MyCommand" m_papp.caption = "The OnClick method for MyCommand has executed" End Sub 17 在代码窗口, 在对象下拉列表中选择 Class, 在功能下拉列表中选择每一个 Class 的成员 ; 18 在 Class 的 Terminate 方法中, 释放 application 的引用 ; Private Sub Class_Terminate() Set m_papp = Nothing End Sub 19 保存工程 ; 20 编译 dll 为 AoDemo_clsMyCommand.dll; 21 在 ArcMap 中使用此自定义的 dll; A 打开 ArcMap, 点击工具菜单, 选择自定义 B 选择命令 C 单击 " 从文件添加 " D 选择 dll 文件, 并打开 E 把此工具拖到某一个工具条上, 关闭自定义对话框 22 测试结果 ; 使用 ArcObjects 程序按照顶点来分割一条线 ArcInfo 编号 : 相关产品及版本 : Desktop,ArcEditor,ArcView,ArcGIS Engine Developer Kit 8.x 9.0 平台 : N/A 提交时间 : 修改时间 : 提交人 : 朱政 内容摘要

59 这篇文章包含了一个 ArcObjects 示例, 告诉您怎么在顶点处分割一个线, 以得到多条单独的线 过程描述 1 打开 ArcMap 2 创建一个新的 UIButtonControl 3 右击新的 UIButtonControl, 选择浏览代码 4 拷贝下面的代码到 UIButtonControl 的点击事件中 Sub SplitAtVertex() Dim pmxdoc As IMxDocument Dim pfeatureclass As IFeatureClass Dim pfeaturelayer As IFeatureLayer Dim pfeaturecursor As IFeatureCursor Dim poutfeaturecursor As IFeatureCursor Dim pfeature As IFeature Dim poutfeaturebuffer As IFeatureBuffer Dim psegmentcollection As ISegmentCollection Dim psegment As ISegment Dim ppointcollection As IPointCollection Dim i As Integer ' 为选择的图层分割线 Set pmxdoc = ThisDocument If Not pmxdoc.selectedlayer Is Nothing Then Set pfeaturelayer = pmxdoc.selectedlayer Else MsgBox "Please select layer to split" Exit Sub End If Set pfeatureclass = pfeaturelayer.featureclass Set pfeaturecursor = pfeatureclass.update(nothing, False) Set poutfeaturecursor = pfeatureclass.insert(true) Set pfeature = pfeaturecursor.nextfeature ' 遍历所有的要素, 在顶点处分割每一个要素并拷贝属性到新的要素中 Do While Not pfeature Is Nothing Set psegmentcollection = pfeature.shape For i = 0 To psegmentcollection.segmentcount - 1 Set psegment = psegmentcollection.segment(i) Set poutfeaturebuffer = pfeatureclass.createfeaturebuffer AddFields poutfeaturebuffer, pfeature Set ppointcollection = New Polyline ppointcollection.addpoint psegment.frompoint

60 ppointcollection.addpoint psegment.topoint Set poutfeaturebuffer.shape = ppointcollection poutfeaturecursor.insertfeature poutfeaturebuffer Next i pfeaturecursor.deletefeature Set pfeature = pfeaturecursor.nextfeature poutfeaturecursor.flush Loop pfeaturecursor.flush ' 刷新 pmxdoc.activeview.refresh End Sub Private Sub AddFields(pFeatureBuffer As IFeatureBuffer, _ pfeature As IFeature) ' 从原来的要素中拷贝属性 Dim prowbuffer As IRowBuffer Dim pnewfields As IFields Dim pnewfield As IField Dim pfields As IFields Dim pfield As IField Dim i As Integer Dim NewFieldIndex As Long Set prowbuffer = pfeaturebuffer Set pnewfields = prowbuffer.fields Set pfields = pfeature.fields For i = 0 To pfields.fieldcount - 1 Set pfield = pfields.field(fieldcount) If Not pfield.type = esrifieldtypegeometry And Not pfield.type = _ esrifieldtypeoid And pfield.editable Then NewFieldIndex = pnewfields.findfield(pfield.name) If Not NewFieldIndex = -1 Then pfeaturebuffer.value(newfieldindex) = pfeature.value(fieldcount) End If End If Next End Sub 5 在 ArcMap 中选择一个图层来分割它包含的所有的线

61 使用 AO 加载 Raster Catalog ArcGIS Engine Developer Kit,ArcGIS 编号 : 相关产品及版本 : Engine Runtime 8.x, 9.x 平台 : N/A 提交时间 : 修改时间 : 提交人 : 董杰内容摘要建立了 Raster Catalog 之后如何使用 AO 将其加载到 Map 上过程描述 C# // open workpace IPropertySet Propset = new PropertySetClass(); Propset.SetProperty("DATABASE",@"D:testAodatarasterRcat.mdb" ); IWorkspaceFactory Fact = new AccessWorkspaceFactoryClass (); //IRasterWorkspaceEx Workspace = Fact.Open(Propset,0) as IRasterWorkspaceEx; IFeatureWorkspace Workspace = Fact.Open(Propset,0) as IFeatureWorkspace; //Open the raster catalog //IRasterCatalog rastercatalog = Workspace.OpenRasterCatalog("sh"); ITable t =Workspace.OpenTable("sh"); IGdbRasterCatalogLayer gdbrastercataloglayer = new GdbRasterCatalogLayerClass(); //gdbrastercataloglayer.setup((itable)rastercatalog); gdbrastercataloglayer.setup(t); MapCtr.Map.AddLayer (gdbrastercataloglayer as ILayer); MapCtr.ActiveView.Refresh (); 把不同层的几次的选择结果加到一个选择集中 编号 : 相关产品及版本 : ArcGIS Engine Developer Kit 9.x 平台 : N/A 提交时间 : 修改时间 : 提交人 : 朱政内容摘要一般情况下, 一次选择的结果是一个选择集, 当得到下一次的选择结果的时候, 前面一次的选择集就自动消失 但有时候选择的操作要分好几次来完成, 并且要把这好几次的选择结果进行累加, 而且这个过程中可能涉及到不同的层的数据 这种需求下我们可以使用 ISelectionEnviroment 这个接口来设置选择模式 过程描述

62 ollection Dim pselenv As ISelectionEnvironment Set pselenv = New SelectionEnvironment pselenv.combinationmethod = esriselectionresultenum.esriselectionresultadd 以上这三句代码您可以放在您要做选择操作之前, 这个时候您可以使用 IMap 的 selectfeature, SelectByShape 等方法进行选择的操作, 操作的结果将会一直进行累加 最后您可以通过 IMap 的 FeatureSelection 来得到选择结果 如何为 ArcObjects 扩展出 "GroupRenderer" 的效果来? 相关产品及版本 : ArcInfo Desktop,ArcEditor,ArcView,ArcGIS Engine Developer Kit,ArcGIS Server 平 2-26 修改时间 : 提 分常用的功能, 所有基于 ArcOjects 组件的 ArcGIS 软件产品 ( 如 : ArcGIS Desktop, ArcGIS Engine, ArcGIS Server), 还有 ArcIMS 和 MapObjects(Windo 法, 详细列举如下 : nderer, UniqueValueMapRenderer, ClassBreaksRenderer, DotDensityRenderer, ProportionalSymbolRenderer, ChartRenderer; erer, SimpleLabelRenderer, ValueMapRenderer, ValueMapLableRenderer, ScaleDependentRenderer, GroupRenderer; n 提供了 ValueMapRenderer, ClassBreaksRenderer, DotDensityRenderer, LabelRenderer, EventRenderer, ZRenderer, GroupRenderer; 供了 SimpleRenderer, ValueMapRenderer, LabelRenderer, ScaleDependentRenderer, GroupRenderer;, 在 ArcIMS 和 MapObjects 的两个版本中都提供的 GroupRender 它本身并不利用任何图层的属性来对图层进行渲染, 而是通过借用其他 Renderer 的功型的渲染效果的同时展现, 比如对一个包含了人口总数量, 男性人口数量和女性人口数量的世界地图图层 ( 面状 ) 先利用人口总数量属性现实分类渲染的效棒图选然展现出两个数值比较的效果 没有实现这种渲染功能 不过基于 COM 技术的 ArcObjects 所具有的可扩展性为我们自己去实现 "GroupRenderer" 提供了可能 效果是通过实例化一个实现了某个渲染接口 (ISimpleRenderer, IUniqueValueMapRenderer, IClassBreaksRenderer, IDotDensityRenderer, IProportiona Class 类, 然后作为该渲染接口类型的变量赋给图层 (IGeoFeatureLayer) 的 Renderer 属性来实现的 这个 Renderer 属性是 IFeatureRenderer 接口类型, 实 ArcObjects 中各种各样的渲染效果就是通过这个 Draw 方法画出来的, 因为各个渲染效果 CoClass 都实现了 IFeatureRenderer 接口 所以要实现 "G 口就可以了 以下提供 VB 和 ArcGIS Server Java API 的例程供大家参考 : er.cls] rer llection ()

63 Err.Description nderer_canrender(byval featclass As esrigeodatabase.ifeatureclass, ByVal Display As esridisplay.idisplay) As Boolean = esrigeometrynull Then der = True der = False.Description rer_draw(byval Cursor As esrigeodatabase.ifeaturecursor, _ stem.esridrawphase, _ y.idisplay, _ ystem.itrackcancel) ount ) erer) And (drawphase = esridpgeography) Then Display, trackcancel aluerenderer) And (drawphase = esridpgeography) Then Display, trackcancel eaksrenderer) And (drawphase = esridpgeography) Then Display, trackcancel sityrenderer) And (drawphase = esridpgeography) Then Display, trackcancel onalsymbolrenderer) And (drawphase = esridpannotation) Then Display, trackcancel nderer) And (drawphase = esridpannotation) Then Display, trackcancel

64 ription rer_preparefilter(byval pfeatclass As esrigeodatabase.ifeatureclass, ByVal QueryFilter As esrigeodatabase.iqueryfilter) ount ) QueryFilter rerenderer_exclusionset(byval pidset As esricarto.ifeatureidset) rerenderer_renderphase(byval drawphase As esrisystem.esridrawphase) As Boolean hase = True " & Err.Description rerenderer_symbolbyfeature(byval Feature As esrigeodatabase.ifeature) As esridisplay.isymbol p.class(0).symbol bolbyfeature = psym yval renderer As esricarto.ifeaturerenderer) =================================================================================================================

65 mples.carto.renderers; tomationexception; erer extends Serializable { C33C1_506B_41F6_B2F0_D6F163CB7699 = 1; my = 0; = "27AC33C1-506B-41F6-B2F0-D6F163CB7699"; ject irenderer) throws IOException, AutomationException; va mples.carto.renderers; r.*;.*; ay.*; atabase.*; m.*; etry.esrigeometrytype; m.esridrawphase; tomationexception; enderer implements IFeatureRenderer, IGroupRenderer { endgroup; ercontext; = new ArrayList(); rer(iservercontext sc) { ndgroupproxy(servercontext.createobject(legendgroup.getclsid())); s = new ILegendClassProxy(sc.createObject(LegendClass.getClsid()));

66 LegendClass); ue); true); n e) { tionexception " + e); tion " + e); FeatureClass ifeatureclass, IDisplay idisplay) throws ception { ype() == esrigeometrytype.esrigeometrynull) { atureclass ifeatureclass, rows IOException, ize(); i++) { w IFeatureRendererProxy(renderers.get(i)); lass, iqueryfilter); rsor ifeaturecursor, int drawphase, cel itrackcancel) throws ception { ize(); i++) { ); nderer && drawphase == esridrawphase.esridpgeography) { w IFeatureRendererProxy(obj); rawphase, idisplay, itrackcancel); luerenderer && drawphase == esridrawphase.esridpgeography) { w IFeatureRendererProxy(obj); rawphase, idisplay, itrackcancel);

67 ksrenderer && drawphase == esridrawphase.esridpgeography) { w IFeatureRendererProxy(obj); rawphase, idisplay, itrackcancel); yrenderer && drawphase == esridrawphase.esridpgeography) { w IFeatureRendererProxy(obj); rawphase, idisplay, itrackcancel); alsymbolrenderer && drawphase == esridrawphase.esridpannotation) { w IFeatureRendererProxy(obj); rawphase, idisplay, itrackcancel); derer && drawphase == esridrawphase.esridpannotation) { w IFeatureRendererProxy(obj); rawphase, idisplay, itrackcancel); yfeature(ifeature ifeature) throws IOException, roup.esri_getclass(0).getsymbol(); se(int drawphase) throws IOException, ByRef(IFeatureIDSet ifeatureidset) throws ception { ject irenderer) throws ception { 的展现出渲染的效果, 还需实现 ILegendInfo 接口, 这里不做详细说明

68 在 AO 或者 ENGINE 中为 SHAPEFILE 添加 SPATIAL INDEX ArcInfo Desktop,ArcGIS Engine 编号 : 相关产品及版本 : Developer Kit 8.3,9.0,9.1 平台 : N/A 提交时间 : 修改时间 : 提交人 : 许春杰内容摘要在 ENGINE 中修改 SHAPE 文件后, 在 ARCIMS 中会出现无法正确显示, 特别是修改比较大的时候 这个时候需要重建 SHAPE 文件的 SPATAIL INDEX 过程描述重建代码如下, 可以在 AO 或者 ENGINE 中使用 Sub CheckforSpatialIndex() Dim pdoc As IMxDocument Set pdoc = ThisDocument 'Get the first layer in the map Dim player As IFeatureLayer Set player = pdoc.focusmap.layer(0) Dim pfc As IFeatureClass Set pfc = player.featureclass 'Check the shapefile to see if it 'already has a spatial index Dim pindexes As IIndexes Dim penumindex As IEnumIndex Set pindexes = pfc.indexes Set pindexes = pfc.indexes If pindexes.findindexesbyfieldname("shape").next Is Nothing Then Debug.Print pfc.aliasname Call AddMyIndex(pFc, pfc.shapefieldname) End If End Sub Public Sub AddMyIndex(pFc As IFeatureClass, strfieldname As String) 'Set up fields Dim pfields As IFields Dim pfieldsedit As IFieldsEdit Dim pfield As IField Dim lfld As Long Set pfields = New Fields Set pfieldsedit = pfields pfieldsedit.fieldcount = 1

69 lfld = pfc.findfield(strfieldname) Set pfield = pfc.fields.field(lfld) Set pfieldsedit.field(0) = pfield Dim pindex As IIndex Dim pindexedit As IIndexEdit Set pindex = New Index 'QI for IIndexEdit Set pindexedit = pindex With pindexedit Set.Fields = pfields.name = "Idx_1" End With 'Add index to feature class pfc.addindex pindex End Sub 如何 ArcObject 的环境中用程序实现 3D 环境中的查询功能 ArcInfo 编号 : 相关产品及版本 : Desktop,ArcEditor,ArcView,ArcGIS 平台 : Extension Win+VB 提交时间 : 修改时间 : 提交人 : 谭军辉 内容摘要在 AO 环境中用程序实现 3D 的查询功能过程描述 Option Explicit Private Sub Form_Load() 'Stop navigating SceneViewerCtrl1.SceneGraph.IsNavigating = False End Sub Private Sub SceneViewerCtrl1_OnLButtonDown(ByVal xpos As Integer, ByVal ypos As Integer, ByVal keyflags As Integer) 'QI for IBasicMap from IScene Dim pbasicmap As IBasicMap

70 Set pbasicmap = SceneViewerCtrl1.SceneGraph.Scene 'QI for IScreenDisplay from ISceneGraph Dim pscreendisplay As IScreenDisplay Set pscreendisplay = SceneViewerCtrl1.SceneGraph 'Get the identify dialog Dim pidentifydialog As IIdentifyDialog Set pidentifydialog = New IdentifyDialog Dim pidentifydialog2 As IIdentifyDialog2 Set pidentifydialog2 = pidentifydialog 'Set identify dialog properties Set pidentifydialog2.basicmap = pbasicmap Set pidentifydialog.display = SceneViewerCtrl1.SceneGraph 'Translate screen coordinates into mulitple 3D objects Dim phit3dset As IHit3DSet SceneViewerCtrl1.SceneGraph.LocateMultiple SceneViewerCtrl1.SceneGraph.ActiveViewer, xpos, ypos, esriscenepickgeography, False, phit3dset 'Clear previous identify results from the dialog pidentifydialog.clearlayers 'Reduce the hit set to the top 'most hits and one hit per layer phit3dset.topmost 1.5 phit3dset.oneperlayer phit3dset.topmost 1.1 'Get an array of hits Dim parray As IArray Set parray = phit3dset.hits If parray.count = 0 Then Exit Sub 'Loop through each hit Dim i As Integer For i = 0 To parray.count - 1 'Get the hit Dim phit3d As IHit3D Set phit3d = parray.element(i) 'Get the hit location Dim ppoint As IPoint Set ppoint = phit3d.point If ppoint Is Nothing Then Exit Sub

71 'Get the layer that was hit If Not TypeOf phit3d.owner Is ILayer Then Exit Sub Dim player As ILayer Set player = phit3d.owner 'Get the feature that was hit Dim pobject As IUnknown Set pobject = phit3d.object 'Add to identify dialog pidentifydialog2.addlayeridentifyobject player, pobject, ppoint Next i 'Display the dialog pidentifydialog.show End Sub 截取任意范围地图区域 ArcInfo 编号 : 相关产品及版本 : Desktop,ArcEditor,ArcView,ArcGIS 平台 : Engine Developer Kit 9.0,9.1 PC-Intel Windows 提交时间 : 修改时间 : 提交人 : 文定梦内容摘要通过区域范围选择所需要的地物, 在大多数情况下是基于矩形范围进行的, 可以使用下面的代码进行任意范围 ( 如多边形 圆等 ) 的地物选取, 并以当前选择范围对地物进行裁剪过程描述 ' 截取任意面积地图区域 Public Sub ClipArea(pGeo As IGeometry, strshppath As String, strshpname As String) On Error GoTo ErrHandle Dim pfilter As ISpatialFilter Set pfilter = New SpatialFilter With pfilter Set.Geometry = pgeo.geometryfield = "SHAPE".SpatialRel = esrispatialrelintersects End With

72 Dim pfinclass As IFeatureClass Dim pinfcfields As IFields Dim pincursor As IFeatureCursor Dim pfeature As IFeature Dim pfoutclass As IFeatureClass Dim poutcur As IFeatureCursor Dim poutbuff As IFeatureBuffer Dim poutfeat As IFeature ' 裁剪 Dim ptopo As ITopologicalOperator Dim index As Long Dim I As Integer Dim pgeom As IGeometry ' 数据源 Set pfinclass = g_fws.openfeatureclass("river") Set pincursor = pfinclass.search(pfilter, False) Dim pinfields As IFields Set pinfields = pfinclass.fields ' 数据输出 Set pfoutclass = CShapefile("D:China-1M", strshpname, pinfields, pfinclass) ' Set pfoutclass = g_fws.openfeatureclass("river-tree") Set pfeature = pincursor.nextfeature Do While Not pfeature Is Nothing Set poutcur = pfoutclass.insert(true) Set poutbuff = pfoutclass.createfeaturebuffer Set poutfeat = poutbuff index = pfeature.fields.findfield("shape") Set ptopo = pfeature.shape ' 这里判断一下该地物的几何类型 ( 点 线 面 ) Set pgeom = pfeature.shape if pfeature.shapetype = 点 then set pgeom = ptopo.intersect(pgeo, esrigeometry0dimension) ' 这里的第二个参数就是区分点 线 面的 elseif pfeature.shape = 线 then set pgeom = ptopo.intersect(pgeo, esrigeometry1dimension) elseif pfeature.shape = 面 then set pgeom = ptopo.intersect(pgeo, esrigeometry2dimension) end if Set poutfeat.shape = pgeom

73 COPYATTRIBUTES pfeature, poutfeat poutcur.insertfeature poutbuff Set pfeature = pincursor.nextfeature I = I + 1 Loop Exit Sub ErrHandle: MsgBox Err.Description & " " & I End Sub ' 拷贝地物属性 Private Sub COPYATTRIBUTES(pSourceFeature As IFeature, pdestinationfeature As IFeature) Dim pfield As IField Dim pfields As IFields Dim prow As IRow Dim FieldCount As Integer Dim count As Integer Dim I As Integer Dim findex As Long Dim bget As Boolean On Error GoTo ErrorHandler Set pfields = pdestinationfeature.fields If psourcefeature.shape.geometrytype = esrigeometrypoint Then count = 1 ElseIf psourcefeature.shape.geometrytype = esrigeometrypolyline Then count = 2 ElseIf psourcefeature.shape.geometrytype = esrigeometrypolygon Then count = 3 End If For I = 0 To pdestinationfeature.fields.fieldcount - 1 Set pfield = pfields.field(i) If pfield.name = "OBJECTID" Or pfield.name = "FID" Or pfield.name = "Shape" Then Else bget = False For FieldCount = 0 To psourcefeature.fields.fieldcount - count If psourcefeature.fields.field(fieldcount).aliasname = pfield.name Then If Not IsNull(pSourceFeature.Value(FieldCount)) Then pdestinationfeature.value(i) = psourcefeature.value(fieldcount) End If bget = True Exit For

74 End If Next FieldCount If Not bget Then If pfield.name = "SHAPE_LEN" Then findex = psourcefeature.fields.findfield("shape.len") pdestinationfeature.value(i) = psourcefeature.value(findex) ElseIf pfield.name = "SHAPE_AREA" Then findex = psourcefeature.fields.findfield("shape.area") pdestinationfeature.value(i) = psourcefeature.value(findex) End If End If End If Next I Set pfield = Nothing Set pfields = Nothing Set prow = Nothing Exit Sub ErrorHandler: MsgBox Err.Description Set pfield = Nothing Set pfields = Nothing Set prow = Nothing End Sub 使用 AO 新增记录的 3 种方法 编号 : 相关产品及版本 : ArcGIS Engine Developer Kit 8.x, 9.x 平台 : N/A 提交时间 : 修改时间 : 提交人 : 董杰 内容摘要 在向 Table FeatureClass 中添加记录的时候有几种可供选用的插入方法 他们在不同的使用环境中效率不同 过程描述

75 Store 方法使用 IRow IFeature 的 Store 由 ITable 或 IFeatureClass 的 CreateRow() CreateFeature() 方法先创建对象经赋值操作后调用 Store 此方法在各种环境中速度均较低但其获得的信息相对最全适用于经 UI 交互产生的数据对象 a) 在 CreateRow() 时进行一次数据库访问 [insert] b) 创建之后已 Row 中已返回 OID 值 c) 其他字段赋值之后调用 Store 进行第二次数据库访问 [updata] 此时激发 Row 对象的 onchange 等事件调用 WriteRow 方法使用 ITableWrite.WriteRow() 或 IFeatureClassWrite.WriteFeature() 由 ITable 或 IFeatureClass 的 CreateRow() CreateFeature() 方法先创建对象经赋值操作后调用 ITable.WriteRow() 或 IFeatureClass.WriteFeature() 此方法调用 ITableWrite 这类较底层的接口区别在于在写入数据时不会激发相应事件在对象不影响网络拓扑结构的前提下写入几何网络图层数据速度较快 a) 在 CreateRow() 时进行一次数据库访问 [insert] b) 创建之后已 Row 中已返回 OID 值 c) 其他字段赋值之后调用 Store 进行第二次数据库访问 [updata] 此时不激发事件 Insert Buffer 使用 ITable.CreateRowBuffer() 或 IFeatureClass.CreateFeatureBuffer() 创建内存对象由 IFeatureCursor.InsertFeature() 写入只访问一次数据库速度较快但是内存对象在写入前 OID=-1 适用于批量写入简单要素 a) 在 CreateRowBuffer() 创建内存对象 b) 创建之后已 Row 中 OID = -1 c) 其他字段赋值之后调用 ICursor.Insert() 进行一次数据库插入此时不会相应事件 如何在 ArcEngine 环境中的 SceneControl 中实现查询功能 编号 : 相关产品及版本 : ArcGIS Extension,ArcGIS 平台 : Engine Developer Kit Win VB 提交时间 : 修改时间 : 提交人 : 谭军辉 内容摘要 如何实现 3D 环境中的 3D 查询功能 过程描述 Public Type m_pobjarray ifeature As ifeature

76 ilayername As String End Type Public M_pFeatureArray() As m_pobjarray Private Sub Identify3DMap(X As Long, Y As Long) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'QI for IBasicMap from IScene Dim pbasicmap As IBasicMap Set pbasicmap = ArcSceneControl.SceneGraph.Scene 'QI for IScreenDisplay from ISceneGraph Dim pscreendisplay As IScreenDisplay Set pscreendisplay = ArcSceneControl.SceneGraph 'Translate screen coordinates into mulitple 3D objects Dim phit3dset As IHit3DSet ArcSceneControl.SceneGraph.LocateMultiple ArcSceneControl.SceneGraph.ActiveViewer, X, Y, esriscenepickgeography, False, phit3dset 'Reduce the hit set to the top 'most hits and one hit per layer phit3dset.topmost 1.5 phit3dset.oneperlayer phit3dset.topmost 1.1 'Get an array of hits Dim parray As IArray Set parray = phit3dset.hits If parray.count = 0 Then Exit Sub 'Loop through each hit Dim i As Integer ReDim M_pFeatureArray(0) For i = 0 To parray.count - 1 'Get the hit Dim phit3d As IHit3D Set phit3d = parray.element(i) 'Get the hit location Dim ppoint As IPoint Set ppoint = phit3d.point If ppoint Is Nothing Then Exit Sub

77 'Get the layer that was hit If Not TypeOf phit3d.owner Is ILayer Then Exit Sub Dim player As ILayer Set player = phit3d.owner 'Get the feature that was hit Dim pobject As IUnknown Set pobject = phit3d.object 'Add to identify dialog ReDim Preserve M_pFeatureArray(UBound(M_pFeatureArray) + 1) Dim pfeature As ifeature Set pfeature = phit3d.object Set M_pFeatureArray(UBound(M_pFeatureArray) - 1).iFeature = pfeature M_pFeatureArray(UBound(M_pFeatureArray) - 1).iLayerName = CStr(pLayer.Name) Next i ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If frmidentify.visible = False Then frmidentify.show 0 End If frmidentify.setfocus Call frmidentify.inittreeview End Sub 删除 FeatureClass 中满足一定条件的 Feature 问题及解决办 法! 删除 FeatureClass 中满足一定条件的 Feature 问题及解决办法 ( 原创 ) 删除 FeatureClass 中满足一定条件的 Feature 碰到一系列问题, 首先要利用 IqueryFilter 接口查出满足条件的 feature, 然后一一删除, 但会有以下问题 : IFeatureCursor pfeaturecursor=pfeature.update(ique,false); IFeature pftr;

78 // 取一个 feature pftr= pfeaturecursor.nextfeature(); while(pftr!=null) { pftr.delete(); // 删除一个 feature pftr= pfeaturecursor.nextfeature(); // 取下一个 feature } 以上代码在删除第一个满足条件的 featue 再删除个一下时就会出错. 必须做如下修改 : IFeatureCursor pfeaturecursor=pfeature.update(ique,false); IFeature pftr; // 取一个 feature pftr= pfeaturecursor.nextfeature(); while(pftr!=null) { pftr.delete(); // 删除一个 feature IFeatureCursor pfeaturecursor=pfeature.update(ique,false); pftr= pfeaturecursor.nextfeature(); // 取下一个 feature } 创建孤立的要素类和数据集中的要素类 ArcInfo 编号 : 相关产品及版本 : Desktop,ArcEditor,ArcView,ArcGIS 平台 : N/A Engine Developer Kit 提交时间 : 修改时间 : 提交人 : 朱政内容摘要下面列出的是创建孤立要素类的代码, 是使用 IFeatureWorkspace 中的 CreateFeatureClass 方法 创建要素集中的要素类使用的是 IFeatureDataset 中的 createfeatureclass 中的方法 创建孤立的要素类指的是在某个工作空间中创建 shapefile 或者是创建不属于任何数据集中的要素类, 创建这类要素类的时候一定要指明 spatial reference, 即使是没有坐标系的也要指定为 UnknownCoordinateSystem 否则创建完毕之后就会出错 而在创建数据集中的要素类就可以不用指定 spatial reference, 如果指定的话需要和数据集中的 spatial reference 相匹配 过程描述

79 Dim ppropertyset As IPropertySet Set ppropertyset = New PropertySet Dim pworkspacefactory As IWorkspaceFactory Dim pworkspace As IWorkspace ppropertyset.setproperty "DATABASE", App.Path + "data" Set pworkspacefactory = New ShapefileWorkspaceFactory Set pworkspace = pworkspacefactory.open(ppropertyset, Me.hWnd) Dim pfeatureworkspace As IFeatureWorkspace Set pfeatureworkspace = pworkspace Dim pfields As IFields Dim pfieldsedit As IFieldsEdit Set pfields = New esrigeodatabase.fields Set pfieldsedit = pfields Dim pfield As IField Dim pfieldedit As IFieldEdit ' 添加一个几何字段 Set pfield = New esrigeodatabase.field Set pfieldedit = pfield pfieldedit.name = "Shape" pfieldedit.type = esrifieldtypegeometry Dim pgeomdef As IGeometryDef Dim pgeomdefedit As IGeometryDefEdit Set pgeomdef = New GeometryDef Set pgeomdefedit = pgeomdef With pgeomdefedit.geometrytype = esrigeometrypolyline ' 在创建孤立的要素类时必须指定 Set.SpatialReference = New UnknownCoordinateSystem End With Set pfieldedit.geometrydef = pgeomdef pfieldsedit.addfield pfield Set pfield = New esrigeodatabase.field Set pfieldedit = pfield With pfieldedit.length = 30

80 .Name = "Well_Dpth".Type = esrifieldtypedouble End With pfieldsedit.addfield pfield Set pfield = New esrigeodatabase.field Set pfieldedit = pfield With pfieldedit.length = 30.Name = "FID".Type = esrifieldtypeoid End With pfieldsedit.addfield pfield Set pfield = New esrigeodatabase.field Set pfieldedit = pfield With pfieldedit.length = 30.Name = "ID".Type = esrifieldtypedouble End With pfieldsedit.addfield pfield ' 创建要素类 Set poutfeatureclass = pfeatureworkspace.createfeatureclass("myshape33", pfields, Nothing, Nothing, esriftsimple, "shape", "") SUM Color of vertex symbols in edit Jul I received responses from Arjen Pluim, of ESRI, Matt Crowder, Stephen Beimborn, & Mark Harris. The code from Arjen was very good. It works when run as a Macro. If my programming skills ever improve, I will add dialog boxes that allow the user to select different colors from the palette, etc. My original question follows, with the response from Arjen last.

81 Hi, I do a lot of editing of features using aerial photos as a background. When I select a feature to edit, and display the vertices, the symbol used is a dark green square. This color is often very difficult to see against the green of the aerial photo. Is it possible to change the default color of the symbol, or the symbol itself? I was thinking yellow, or a symbol with a circle with an X in it. Obviously the best solution would allow me to change the color or symbol on the fly to better contrast against the background I am currently using. Thanks in advance for any help, and I will SUM. Gary Responses; One of the samples from the ESRI ArcObjects Developer Kit might help you with this. It changes the size of the active vertex and the color and size of the non-active vertices. You can change the colors and sizes as you like. It could be that you can also change the symbol from SimpleMarkerSymbol to CharacterMarkerSymbol, but I haven't tested that. Hope this helps. Cheers, Arjen Public Sub ChangeSketchVertexSymbolColors() Dim peditor As IEditor Dim pid As New UID Dim peditprops As IEditProperties Dim pvertexsym As ISimpleMarkerSymbol Dim pvertexcolor As IRgbColor Dim pselectedcolor As IRgbColor Dim pselectedvertexsym As ISimpleMarkerSymbol 'Get a handle to the Editor pid = "esricore.editor" Set peditor = Application.FindExtensionByCLSID(pID) Set peditprops = peditor 'Create a new Color object Set pvertexcolor = New RgbColor pvertexcolor.blue = 150

82 'create a new MarkerSymbol and apply it to the Edit Sketch Properties Set pvertexsym = New SimpleMarkerSymbol With pvertexsym.color = pvertexcolor.style = esrismsdiamond.size = 8 End With Set peditprops.sketchvertexsymbol = pvertexsym 'now change the selected vertex symbol Set pselectedvertexsym = New SimpleMarkerSymbol Set pselectedcolor = New RgbColor pselectedcolor.red = 255 With pselectedvertexsym.color = pselectedcolor.size = 8.Style = esrismsdiamond End With 'apply the new symbol to the Edit Sketch Properties Set peditprops.selectedvertexsymbol = pselectedvertexsym End Sub ~~~~~~~~~~~~~~~~~~~~~~ Gary Young GIS Specialist US Bureau of Reclamation Burley ID ex 16 gyoung@pn.usbr.gov

83 要素动态跟踪的算法 这个算法其实很简单, 核心原理是在一个 timer_tick 事件中不断改变一个 markerelement 的 geometry 而我们关注的目标也是这些符合条件的 geometry 如何得到 1.polyline 上的节点我们我们要取一条 polyline 上的节点, 这个方法是非常简单的, 使用 ipointcollection 接口对象 ppts, 我们通过 QI 一条 polyline, 可以获取这些点集合 dim ppts as ipointcollection ppts=ppolyline 其中的点从 ppts.point(i) 中取得 2. 获取均匀点如果一条线很长, 但是只有一个 segment, 那么点将很快移动完毕, 这样肯定我们也不满意, 我们希望能够不管线的长度是多少, 一定要让点移动 10 次, 我们就必须找出一条线上等距离的 11 个点的位置出来, 算法如下 : Function MakeMultiPoint(ByVal pgeometry As IGeometry, ByVal npoints As Integer) As IGeometryCollection Dim pgeometrycollection As IGeometryCollection If TypeOf pgeometry Is IPolyline Then ' return a multipoint containing npoints equally ' distributed on the Polyline Dim pconstructgeometrycollection As IConstructGeometryCollection pconstructgeometrycollection = New GeometryBag pconstructgeometrycollection.constructdivideequal(pgeometry, npoints - 1, esriconstructdivideenum.esridivideintopolylines) Dim penumgeometry As IEnumGeometry penumgeometry = pconstructgeometrycollection pgeometrycollection = New Multipoint Dim ppolyline As IPolyline ppolyline = penumgeometry.next pgeometrycollection.addgeometry(ppolyline.frompoint) Do While Not ppolyline Is Nothing pgeometrycollection.addgeometry(ppolyline.topoint) ppolyline = penumgeometry.next Loop End If MakeMultiPoint = pgeometrycollection pgeometrycollection = Nothing End Function 这个函数可取出符合要求的点集出来

84 // 闪烁目标 public static void FlashFeature(AxMapControl mapcontrol,ifeature ifeature, IMap imap) { IActiveView iactiveview = imap as IActiveView; if (iactiveview!= null) { iactiveview.screendisplay.startdrawing(0, (short)esriscreencache.esrinoscreencache); // 根据几何类型调用不同的过程 switch (ifeature.shape.geometrytype) { case esrigeometrytype.esrigeometrypolyline: FlashLine(mapControl, iactiveview.screendisplay, ifeature.shape); break; case esrigeometrytype.esrigeometrypolygon: FlashPolygon(mapControl, iactiveview.screendisplay, ifeature.shape); break; case esrigeometrytype.esrigeometrypoint: FlashPoint(mapControl, iactiveview.screendisplay, ifeature.shape); break; default: break; } iactiveview.screendisplay.finishdrawing(); } } // 闪烁线 static void FlashLine(AxMapControl mapcontrol,iscreendisplay iscreendisplay,igeometry igeometry) {

85 ISimpleLineSymbol ilinesymbol; ISymbol isymbol; IRgbColor irgbcolor; ilinesymbol = new SimpleLineSymbol(); ilinesymbol.width = 4; irgbcolor = new RgbColor(); irgbcolor.red = 255; ilinesymbol.color = irgbcolor; isymbol = (ISymbol)iLineSymbol; isymbol.rop2 = esrirasteropcode.esriropnotxorpen; mapcontrol.flashshape(igeometry, 3, 200, isymbol); } // 闪烁面 static void FlashPolygon(AxMapControl mapcontrol, IScreenDisplay iscreendisplay, IGeometry igeometry) { ISimpleFillSymbol ifillsymbol; ISymbol isymbol; IRgbColor irgbcolor; ifillsymbol = new SimpleFillSymbol(); ifillsymbol.style = esrisimplefillstyle.esrisfssolid; ifillsymbol.outline.width = 12; irgbcolor = new RgbColor(); irgbcolor.rgb = System.Drawing.Color.FromArgb(100, 180, 180).ToArgb(); ifillsymbol.color = irgbcolor; isymbol = (ISymbol)iFillSymbol; isymbol.rop2 = esrirasteropcode.esriropnotxorpen;

86 iscreendisplay.setsymbol(isymbol); mapcontrol.flashshape(igeometry, 3, 200, isymbol); } // 闪烁点 static void FlashPoint(AxMapControl mapcontrol, IScreenDisplay iscreendisplay, IGeometry igeometry) { ISimpleMarkerSymbol imarkersymbol; ISymbol isymbol; IRgbColor irgbcolor; imarkersymbol = new SimpleMarkerSymbol(); imarkersymbol.style = esrisimplemarkerstyle.esrismscircle; irgbcolor = new RgbColor(); irgbcolor.rgb = System.Drawing.Color.FromArgb(0, 0, 0).ToArgb(); imarkersymbol.color = irgbcolor; isymbol = (ISymbol)iMarkerSymbol; isymbol.rop2 = esrirasteropcode.esriropnotxorpen; mapcontrol.flashshape(igeometry, 3, 200, isymbol); } 同时闪烁满足条件的记录 n 次 Private Sub FlashManyShape(pFLayer As IFeatureLayer, OID() As Long, times As Long, pav As IActiveView) '* 功能 : 使一组 feature 闪动数次或无数次 -- 注意 : 闪动无数次的功能不可能在一个单一的函数中实现, 须配合一个外部变量 '* 参数 : pflayer--feature 所在的图层 OID--feature 的 Object ID times--feature 的闪动数次 pav-- 与 pflayer 相关联的 Activeview On Error GoTo EH:

87 Dim pgeometry() As IGeometry Dim n As Long Dim pgeotype As tagesrigeometrytype Dim pmarkersymbol As IMarkerSymbol Dim plinesymbol As ILineSymbol Dim pfillsymbol As IFillSymbol Dim psym As ISymbol Dim psd As IScreenDisplay Dim i As Long, j As Long Set pfeatcls = pflayer.featureclass n = UBound(OID) ReDim pgeometry(n) For i = 0 To n - 1 Set pgeometry(i) = pfeatcls.getfeature(oid(i)).shape 'pf.shape Next i Set pcolor = New RgbColor pgeotype = pgeometry(0).geometrytype Select Case pgeotype Case esrigeometrypolyline Set plinesymbol = New SimpleLineSymbol With pcolor.usewindowsdithering = False.Red = 0.Green = 64.Blue = 0 End With plinesymbol.color = pcolor plinesymbol.width = 2 Set psym = plinesymbol Case esrigeometrypolygon Set pfillsymbol = New SimpleFillSymbol With pcolor.usewindowsdithering = False.Red = 250.Green = 0.Blue = 0 End With pfillsymbol.color = pcolor pfillsymbol.outline = plinesymbol Set psym = pfillsymbol

88 EH: Case Else Exit Sub End Select psym.rop2 = esriropnotxorpen Set psd = pav.screendisplay With psd.startdrawing 0, esrinoscreencache.setsymbol psym Select Case pgeotype Case esrigeometrypolyline If times > 0 Then For i = 1 To times For j = 0 To n.drawpolyline pgeometry(j) Next Sleep 200 For j = 0 To n.drawpolyline pgeometry(j) Next Sleep 200 DoEvents Next End If Case esrigeometrypolygon If times > 0 Then For i = 1 To times For j = 0 To n.drawpolygon pgeometry(j) Next Sleep 200 For j = 0 To n.drawpolygon pgeometry(j) Next Sleep 200 DoEvents Next End If End Select.FinishDrawing End With Exit Sub MsgBox " 闪烁过程中出现错误 :" & Err.Description, vbexclamation, "

89 系统错误提示 " End Sub 旋转地图 :37:05 大中小编号 : 相关产品及版本 : ArcInfo Desktop,ArcGIS Engine Developer Kit,ArcGIS Engine Runtime 9.1 平台 : PC-Intel Windows 提交时间 : 修改时间 : 提交人 : 黄齐飞内容摘要 转载于 旋转当前的地图 过程描述使用 IScreenDispaly::RotateStart 接口来实现旋转地图功能 代码如下 : Add a UIToolControl to any toolbar. Paste this code in for the control. Make sure the names match. Load some data and zoom into a desired location. Select the UIToolControl. As you drag an arc on the focus map, the focus map rotates. Release the mouse to set the final rotation angle. Option Explicit Private m_pmxdoc As IMxDocument Private m_pactiveview As IActiveView Private m_pscreendisplay As IScreenDisplay Private m_brotating As Boolean Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long) Dim penv As IEnvelope Dim pcenterpoint As IPoint Dim ptransform As IDisplayTransformation Set m_pmxdoc = Application.Document Set m_pactiveview = m_pmxdoc.focusmap Set m_pscreendisplay = m_pactiveview.screendisplay

90 'Rotate around the display's center point Set ptransform = m_pscreendisplay.displaytransformation Set penv = ptransform.fittedbounds Set pcenterpoint = New Point pcenterpoint.putcoords ((penv.xmax + penv.xmin) / 2), ((penv.ymax + penv.ymin) / 2) 'Start the rotation m_pscreendisplay.rotatestart m_pmxdoc.currentlocation, pcenterpoint m_brotating = True End Sub Private Sub UIToolControl1_MouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long) If Not button = 1 Then Exit Sub If Not m_brotating Then Exit Sub 'Update rotation m_pscreendisplay.rotatemoveto m_pmxdoc.currentlocation m_pscreendisplay.rotatetimer End Sub Private Sub UIToolControl1_MouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long) Dim drotationangle As Double If Not button = 1 Then Exit Sub 'Complete the rotation and refresh the diplay m_brotating = False drotationangle = m_pscreendisplay.rotatestop m_pscreendisplay.displaytransformation.rotation = drotationangle m_pactiveview.refresh End Sub AE 开发中矢量图层叠加求交分析 : AE 开发中, 矢量图层叠加分析需要用到的主要类为 BasicGeoprocessor, 其主要接口为 IBasicGeoprocessor IBasicGeoprocessor 接口提供了基本的空间数据处理的方法和属性, 其中包括叠加求交 (Interset) 和叠加求和 (Union) 下面提供两个叠加求交的开发实例 : 一 VB+AE9.1 叠加求交示例代码 : 1 Private Sub M_OverLayer_Click() 2' Get the input layer and feature class

91 3 Dim player As ILayer 4 Set player = MapControl1.Layer(0) 5 Dim pinputfeatlayer As IFeatureLayer 6 Set pinputfeatlayer = player 7 ' Use the Itable interface from the Layer (not from the FeatureClass) 8 9 Dim pinputtable As ITable 10 Set pinputtable = player 11 ' Get the input feature class. 12 ' The Input feature class properties, such as shape type, 13 ' will be needed for the output Dim pinputfeatclass As IFeatureClass 16 Set pinputfeatclass = pinputfeatlayer.featureclass 17 ' Get the overlay layer 18 ' Use the Itable interface from the Layer (not from the FeatureClass) 19 Set player = MapControl1.Layer(1) 20 Dim poverlaytable As ITable 21 Set poverlaytable = player ' Error checking 24 If pinputtable Is Nothing Then 25 MsgBox "Table QI failed" 26 Exit Sub 27 End If If poverlaytable Is Nothing Then 30 MsgBox "Table QI failed" 31 Exit Sub 32 End If

92 33 34 ' Define the output feature class name and shape type (taken from the 35 ' properties of the input feature class) 36 Dim pfeatclassname As IFeatureClassName 37 Set pfeatclassname = New FeatureClassName 38 With pfeatclassname 39.FeatureType = esriftsimple 40.ShapeFieldName = "Shape" 41.ShapeType = pinputfeatclass.shapetype 42 End With ' Set output location and feature class name 45 Dim pnewwsname As IWorkspaceName 46 Set pnewwsname = New WorkspaceName 47 pnewwsname.workspacefactoryprogid = "esricore.shapefileworkspacefactory.1" 48 pnewwsname.pathname = "C:\temp" Dim pdatasetname As IDatasetName 51 Set pdatasetname = pfeatclassname 52 pdatasetname.name = "Intersect_result" 53 Set pdatasetname.workspacename = pnewwsname 54 ' Set the tolerance. Passing 0.0 causes the default tolerance to be used. 55 ' The default tolerance is 1/10,000 of the extent of the data frame's spatial domain Dim tol As Double 58 tol = 0# ' Perform the intersect 59 Dim pbgp As IBasicGeoprocessor 60 Set pbgp = New BasicGeoprocessor Dim poutputfeatclass As IFeatureClass

93 63 Set poutputfeatclass = pbgp.intersect(pinputtable, False, poverlaytable, False, _ 64 tol, pfeatclassname) ' Add the output layer to the map 67 Dim poutputfeatlayer As IFeatureLayer 68 Set poutputfeatlayer = New FeatureLayer 69 Set poutputfeatlayer.featureclass = poutputfeatclass 70 poutputfeatlayer.name = poutputfeatclass.aliasname 71 MapControl1.AddLayer poutputfeatlayer 72End Sub 二 C#+AE9.1 叠加求交示例代码 : 1 private void M_OverLayer_Click(object sender, System.EventArgs e) 2 { 3 try 4 { 5 // 分析层 6 ILayer player=this.axmapcontrol1.get_layer(0); 7 IFeatureLayer pinputfeatlayer=player as IFeatureLayer; 8 ITable pinputtable=player as ITable; 9 IFeatureClass pinputfeatclass=pinputfeatlayer.featureclass; // 叠加表 12 player=this.axmapcontrol1.get_layer(1); 13 ITable poverlaytable=player as ITable; // 叠加分析表 16 IFeatureClassName pfeatclassname=new FeatureClassNameClass();

94 17 pfeatclassname.featuretype=esrifeaturetype.esriftsimple; 18 pfeatclassname.shapefieldname="shape"; 19 pfeatclassname.shapetype=pinputfeatclass.shapetype; // 工作空间名称 22 IWorkspaceName pnewwsname=new WorkspaceNameClass(); 23 pnewwsname.workspacefactoryprogid = "esridatasourcesfile.shapefileworkspacefactory"; 24 pnewwsname.pathname // 数据集名称 27 转载 -AO 代码 Display) :37:15 大中小发信人 : zdq ( 我就是哈哈 (HaHa)), 信区 : DigitalEarth 标题 : 转载 -AO 代码 Display) 发信站 : 水木社区 (Tue Jun 6 12:29: ), 站内 显示设计模式为了帮助你理解怎样和各种显示对象一起工作来解决一般的开发需求, 一些应用情节和细节在他们执行被给 用这些模式作为显示对象一起工作的引点 应用窗口最一般的任务之一是来在支持滚动和备份存储的应用窗口的客户端区域绘制地图 这个显示对象在下面的情况可能被用 初始化当窗口被创建时, 通过创建一个 Screen Display 开始 你需要创建一个或多个符号用来绘制形状 使应用句柄到 pscreendisplay.hwnd 从它 IDisplayTransformation 接口的 Screen Display 得到和用 ptransformation.bounds 和 pdisplaytransform.visiblebounds 来设置全图和可视范围 可视范围决定当前空间水平 Screen Display 关心更新 DeviceFrame 的转化显示 Screen Display 管理窗口的消息和一般的事件的句柄像窗口的大小和滚动

95 Private m_pscreendisplay As IScreenDisplay Private m_pfillsymbol As ISimpleFillSymbol Private Sub Form_Load() Set m_pscreendisplay = New ScreenDisplay m_pscreendisplay.hwnd = Picture1.hWnd Set m_pfillsymbol = New SimpleFillSymbol Dim penv As IEnvelope Set penv = New Envelope penv.putcoords 0, 0, 50, 50 m_pscreendisplay.displaytransformation.bounds = penv m_pscreendisplay.displaytransformation.visiblebounds = penv End Sub 绘画显示对象定义一个基本的 IDraw 接口, 这个接口很容易对任何显示的绘制 只要你用 IDraw 或 IDisplay 来执行你的绘制代码, 你不用担心你要绘制的哪一种设备 一个绘制过程用 StartDrawing 开始和用 FinishDrawing 完成 例如, 创建一个程序在屏幕中心建立一个多边形并且绘制它 这个形状用默认的符号 Private Function GetPolygon() As IPolygon Set GetPolygon = New Polygon Dim ppointcollection As IPointCollection Set ppointcollection = GetPolygon Dim ppoint As IPoint Set ppoint = New Point ppoint.putcoords 20, 20 ppointcollection.addpoint ppoint ppoint.putcoords 30, 20 ppointcollection.addpoint ppoint ppoint.putcoords 30, 30 ppointcollection.addpoint ppoint ppoint.putcoords 20, 30 ppointcollection.addpoint ppoint GetPolygon.Close End Function Private Sub MyDraw(pDisplay As IDisplay, hdc As esrisystem.ole_handle) ' Draw from Scratch Dim pdraw As IDraw Set pdraw = pdisplay pdraw.startdrawing hdc, esrinoscreencache Dim ppoly As IPolygon Set ppoly = GetPolygon() pdraw.setsymbol m_pfillsymbol pdraw.draw ppoly pdraw.finishdrawing End Sub

96 这段程序可以在任何设备中绘制多边形 不管怎么样, 第一地方我们需要绘制到窗口 为了处理这个, 在那些应用程序的 Screen Display 的指示器和 PictureBox 的句柄的 PictureBox 的 Paint 方法中写一些代码到 MyDraw 程序中去 注意这个程序接受显示指示器和窗口设备 Private Sub Picture1_Paint() MyDraw m_pscreendisplay, Picture1.hDC End Sub 增加显示缓冲区一些绘画过程可能花一段时间才能完成 一个简单的方法来提高性能就是用运显示缓冲区 这个涉及到 Screen Display 的能力来记录你的绘画过程到一个位图中, 然后当不论何时 Paint 方法被调用, 就用这个位图来刷新图片的窗口 直到你的数据改变和你调用 IScreenDisplay::Invalidate 来指定哪个缓冲区是无效的, 这个缓冲区就会被用 有两种缓冲区 : 一个是记录缓冲区, 一个是用户联合缓冲区 用记录在应用程序的 Paint 方法中来执行显示缓冲区 Private Sub Picture1_Paint() If (m_pscreendisplay.iscachedirty(esriscreenrecording)) Then m_pscreendisplay.startrecording MyDraw m_pscreendisplay, Picture1.hDC m_pscreendisplay.stoprecording Else Dim rect As tagrect m_pscreendisplay.drawcache Picture1.hDC, esriscreenrecording, rect, rect End If End Sub 当你执行这个代码时, 你将会看到在屏幕上什么也没有画 这个由于 ScreenRecording 缓冲区没有设置 为确定 MyDraw 函数被调用, 当首先绘画消息被接收, 你一定要使缓冲区无效 增加下面的一行到 Form_load 方法的后面 m_pscreendisplay.invalidate Nothing, True, esriscreenrecording 一些应用, 如 ArcMap, 可能需要多个显示缓冲区 为利用多个缓冲区, 用到下面的步骤 : 1 用 IScreenDisplay::AddCache 增加新的缓冲区 返回时保存缓冲区的 ID 2 为绘制你的缓冲区, 指定缓冲区的 ID 开始,StartDrawing 3 为使缓冲区无效, 指定缓冲区的 ID 失效,Invalidate 4 为了从缓冲区中绘制, 指定缓冲区 ID 绘制,DrawCache 为了改变应用例子支持自己的缓冲区, 做下面的改变 : 1) 增加新变量来保持新的缓冲区 Private m_lcacheid As Long 2) 在 Form_load 方法中创建缓冲区 m_lcacheid = m_pscreendisplay.addcache 3) 用 m_icacheid 变量和从 Paint 方法中移除开始和停止记录来适当的改变调用 移动, 大小变化和旋转显示对象一个强大的特征能力就是在你绘制地图上放大和缩小 它用放大, 缩小或平移工具很容易执行 滚动被自动处理 在你的地图上放在缩小, 简单设置你的可视范围 例如, 增加一个按键到表格上, 放入下面的代码, 这个通过固定的数来变化屏幕, 在 Click 事件按键中 Private Sub Command1_Click()

97 Dim penv As IEnvelope Set penv = m_pscreendisplay.displaytransformation.visiblebounds penv.expand 0.75, 0.75, True m_pscreendisplay.displaytransformation.visiblebounds = penv m_pscreendisplay.invalidate Nothing, True, esriallscreencaches End Sub Screen Display 执行 TrackPan 方法, 这个调用主要是鼠标按下事件让用户平移视图 你可以通过设置 DisplaytransFormation 的 Rotation 属性值来以屏幕为中心旋转实体 Rotation 指定是以度表示 Screen Display 执行 TrackRotate 方法, 这个调用是鼠标按下事件让用户相互旋转视图 打印打印与屏幕绘制非常相似 当绘制到打印机时, 你不用担心缓冲区或者滚动,Simple Display 被用 创建 Simple Display 对象和通过复制 Screen Display 的变化来初始化它的变化 设置打印机的变化的设备框架的打印页的像素边的值 最后, 用 Simple Display 和打印机的句柄从草图绘制 输出元文件这个 GDIDisplay 对象被用来表示一个元文件 创建元文件和打印之间有少许不同 如果你指定 lpbounds 变量为 0 到 CreateEnhMetaFile, 这个 MyDraw 程序能够被用 仅仅用 hprinterdc 来代替 hmetafiledc 如果你想要指定 CreateEnhMetafFile 的范围, 设置 DisplayTransformation 的 DeviceFrame 相同的矩形的像素版本 打印结构一些工程可能需要直接输出到输出设备的某些下一级矩形 它通过设置 Displaytransformation 的设备框架像素范围少于完全设备范围很容易处理这些 过滤非常高级的绘制效果, 像颜色透明度, 用显示过虑能够完成 过虑和显示缓冲区一起工作, 允许你的光栅版本 (rasterized version) 的绘制操作 当一个过虑被指定到显示视图时 ( 用 IDisplay::putrefy_displayFilter), 这个显示创建一个和用记录缓冲区提供栅格信息一起的内部过虑缓冲区 输出是直到过虑被清除就发送到过虑缓冲区 (putref_displayfilter(0)) 在哪一点上调用 IDisplayFilter::Apply.Apply 接收当前背景位图 ( 记录缓冲区 ), 绘制缓冲区 ( 包含被指定过虑的哪些所有绘画 ) 和目的地的句柄 透明过虑在这些位图上执行 (alphblending) 和得到颜色透明度把他们绘制到目标的句柄 新的过虑能被创建执行其他的一些效果 例子画点 [C#] public void OnMouseDown(int Button, int Shift, int X, int Y) { IMxDocument mxdoc = m_app.document as IMxDocument; IActiveView activeview = mxdoc.focusmap as IActiveView; IScreenDisplay screendisplay = activeview.screendisplay; screendisplay.startdrawing(screendisplay.hdc, (short) esriscreencache.esrinoscreencache); screendisplay.setsymbol(new SimpleMarkerSymbolClass()); screendisplay.drawpoint(mxdoc.currentlocation); screendisplay.finishdrawing();

98 } 画线 public void OnMouseDown(int Button, int Shift, int X, int Y) { IMxDocument mxdoc = m_app.document as IMxDocument; IActiveView activeview = mxdoc.focusmap as IActiveView; IScreenDisplay screendisplay = activeview.screendisplay; ISimpleLineSymbol linesymbol = new SimpleLineSymbolClass(); IRgbColor rgbcolor = new RgbColorClass(); rgbcolor.red = 255; linesymbol.color = rgbcolor; IRubberBand rubberline = new RubberLineClass(); IPolyline newpolyline = (IPolyline)rubberLine.TrackNew(screenDisplay, (ISymbol)lineSymbol); screendisplay.startdrawing(screendisplay.hdc, (short)esriscreencache.esrinoscreencache); screendisplay.setsymbol((isymbol)linesymbol); screendisplay.drawpolyline(newpolyline); screendisplay.finishdrawing(); } 画面 public void OnMouseDown(int Button, int Shift, int X, int Y) { IMxDocument mxdoc = m_app.document as IMxDocument; IActiveView activeview = mxdoc.focusmap as IActiveView; IScreenDisplay screendisplay = activeview.screendisplay; ISimpleFillSymbol fillsymbol = new SimpleFillSymbolClass(); IRgbColor rgbcolor = new RgbColorClass(); rgbcolor.red = 255; fillsymbol.color = rgbcolor; IRubberBand rubberpolygon = new RubberPolygonClass(); IPolygon newpolygon = (IPolygon)rubberPolygon.TrackNew(screenDisplay, (ISymbol)fillSymbol); screendisplay.startdrawing(screendisplay.hdc, (short)esriscreencache.esrinoscreencache); screendisplay.setsymbol((isymbol)fillsymbol); screendisplay.drawpolygon(newpolygon); screendisplay.finishdrawing(); } 画矩形 public void OnMouseDown(int Button, int Shift, int X, int Y) { IMxDocument mxdoc = m_app.document as IMxDocument; IActiveView activeview = mxdoc.focusmap as IActiveView; IScreenDisplay screendisplay = activeview.screendisplay; ISimpleFillSymbol fillsymbol = new SimpleFillSymbolClass();

99 IRgbColor rgbcolor = new RgbColorClass(); rgbcolor.red = 255; fillsymbol.color = rgbcolor; IRubberBand rubberenv = new RubberEnvelopeClass(); IEnvelope newenvelope = (IEnvelope)rubberEnv.TrackNew(screenDisplay, (ISymbol)fillSymbol); screendisplay.startdrawing(screendisplay.hdc, (short)esriscreencache.esrinoscreencache); screendisplay.setsymbol((isymbol)fillsymbol); screendisplay.drawrectangle(newenvelope); screendisplay.finishdrawing(); } 在 arcengine 中标注字段属性数据 :13:00 大中小在 arcengine 中标注字段属性数据 IGeoFeatureLayerPtr pgeolyr; IAnnotateLayerPropertiesCollectionPtr plabcol; IAnnotateLayerPropertiesPtr plab; ILabelEngineLayerPropertiesPtr plabeng; ILayerPtr iplayer = m_mapcontrol.getlayer(0); IFeatureLayerPtr ipflayer = iplayer; pgeolyr = ipflayer; pgeolyr->get_annotationproperties(&plabcol); plabeng.createinstance(clsid_labelenginelayerproperties); plabeng->put_expression(ccombstr("[ 单位 ]")); plabeng->putref_symbol(gettextsymbol(12)); plabeng->put_isexpressionsimple(variant_true); plab = plabeng; plabcol->clear(); plabcol->add(plab); pgeolyr->put_displayannotation(variant_true); IActiveViewPtr ipactiveview = m_mapcontrol.getactiveview(); ipactiveview->refresh();

100 IfeatureSelection:SelectFeatures 方法介绍 :05:03 大中小已知一个要素图层和我们的选择条件, 寻找出符合要求的要素并闪烁显示, 使用的 IfeatureSelection 接口的 SelectFeatures 方法 Public Sub searchselection(byval sqlfilter as string, byval pfeatlyr as ifeaturelayer) Dim pfilter As IqueryFilter 做一个过滤器 pfilter = New QueryFilter pfilter.whereclause = sqlfilter 如 "area>100000",arcgis 中的字段值是区分大小写的, 如 nevada 不能写成 Nevada Dim pfeatureselection As IFeatureSelection 获取图层 pfeatureselection = pfeatlyr QI pfeatureselection.selectfeatures(pfilter, esriselectionresultenum.esriselectionresultnew, False) 重要方法 Dim pcolor As IRgbColor pcolor = New RgbColor pcolor.red = 220 pcolor.green = 112 pcolor.blue = 60 pfeatureselection.selectioncolor = pcolor 将选择集添上颜色 AxMapControl1.CtlRefresh(esriViewDrawPhase.esriViewGeoSelection) 控件局部刷新 Dim pfeatset As IselectionSet 新建一个 selectionset 对象, 它用于保存获得的要素 pfeatset = pfeatureselection.selectionset Dim pfeatcursor As IFeatureCursor pfeatset.search(nothing, True, pfeatcursor) 使用要素游标去获取单个要素 Dim pfeat As IFeature pfeat = pfeatcursor.nextfeature Do Until pfeat Is Nothing If Not pfeat Is Nothing Then Dim pfillsyl2 As ISimpleFillSymbol pfillsyl2 = New SimpleFillSymbol pfillsyl2.color = getrgb(220, 60, 60) AxMapControl1.FlashShape(pFeat.Shape, 15, 20, pfillsyl2) 被选中的要素闪烁 将要素的某个字段值写入 LISTBOX ListBox1.Items.Add(pFeat.Value(pFeatCursor.FindField("state_name")))

101 ListBox1.Refresh() 可以使 listbox 中的项逐个出现 End If pfeat = pfeatcursor.nextfeature Loop End Sub 我们需要注意 将选择集添上颜色 这个语句, 在这个过程中, 符合要求的要素将呈选择状态, 我们可以使用另外一种方法来设置选择集的颜色 : Dim pselenv As ISelectionEnvironment Dim prgbcolor As IRgbColor Set pselenv = New SelectionEnvironment Set prgbcolor = New RgbColor prgbcolor.red = 255 pselenv.areaselectionmethod = esrispatialrelintersects Set pselenv.defaultcolor = prgbcolor MapControl1.Map.SelectByShape MapControl1.TrackCircle, pselenv, False MapControl1.Refresh esriviewgeography 如上面代码中看到的,SelectionEnvironment 能够控件的要素选择集的缺省颜色, 缺省 symbol 等 评论 (4) 引用 阅读 (46) 打印 文章评论 以下网友留言只代表其个人观点, 不代表新浪网的观点或立场笨耗子 :18:43 谢谢你的回复, 这一次我去掉了用户控件, 直接用个 mapcontrol 来测试, 代码如下 : private void button1_click(object sender, System.EventArgs e) { IFeatureLayer pfeaturelayer = (IFeatureLayer) this.mapcontrol1.get_layer(0); IFeatureClass pfeacls = pfeaturelayer.featureclass; IFeature pfea = pfeacls.getfeature(2); ISimpleFillSymbol pfillsyl = new SimpleFillSymbol(); pfillsyl.color =GetRGBColor(220, 60, 60); this.mapcontrol1.flashshape(pfea.shape,15,300,pfillsyl); this.mapcontrol1.extent = pfea.shape.envelope; MessageBox.Show(this.MapControl1.get_Layer(0).Name.ToString()); MessageBox.Show(pFea.get_Value(2).ToString()); }

102 测试时两个 MessageBox 都显示正常, 但地图没有任何变化, 说明前面两句 : 闪烁和图幅变化都没有执行, 运行并无抱错, 我实在是不知怎么找到错误了, 望你能指点一下检查途径, 谢谢你! 笨耗子 :19:04 Dim pfeatlyr As IFeatureLayer pfeatlyr = AxMapControl1.Map.Layer(0) Dim pfeatclass As IFeatureClass pfeatclass = pfeatlyr.featureclass Dim pfeatcursor As IFeatureCursor pfeatcursor = pfeatclass.search(nothing, False) Dim pfillsymbol As IFillSymbol pfillsymbol = New SimpleFillSymbol Dim prgbcolor As IRgbColor prgbcolor = New RgbColor prgbcolor.red = 110 prgbcolor.green = 201 prgbcolor.blue = 30 pfillsymbol.color = prgbcolor Dim pfeat As IFeature pfeat = pfeatcursor.nextfeature Do While Not pfeat Is Nothing AxMapControl1.FlashShape(pFeat.Shape, 5, 30, pfillsymbol) pfeat = pfeatcursor.nextfeature Loop 我看了你的代码后自己写的一个试验代码, 绝对没有任何问题, 你的问题是否出现在要素太小你看不到? 闪烁次数不要 15, 搞个 3 就可以了, 时间也不用 300,30 就可以

103 AO 基本函数集合 ( 很多函数功能 ) :23:45 大中小 Attribute VB_Name = "GlobalFun" '''''''''''''''''''''''''''''''''''''''''''''''''''' ' 模块功能 : 全局对象函数 ' 模块说明 : ' 参数描述 : ' 创建人 : ' 完成日期 : ' 修改日期 :( 包括修改日期, 修改人, 修改函数 ) ' 1. ' 2. '''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long) Option Explicit ' 查找图层只是在第一层中查找 Public Function FindTopLayer(strLayerName As String) As ILayer Dim pmap As IMap Dim pmxdoc As IMxdocument. Dim player As ILayer Dim i As Integer Set pmxdoc = g_spapp.document. Set pmap = pmxdoc.focusmap For i = 0 To pmap.layercount - 1 If pmap.layer(i).name = strlayername Then Set FindTopLayer = pmap.layer(i) Exit Function End If Next i End Function ' 查找 grouplayer 图层 Public Function FindGroupLayer(strLayerName As String) As IGroupLayer Dim pmap As IMap Dim pmxdoc As IMxdocument. ' 这里用 UID 的方法 Dim penumlayer As IEnumLayer Dim player As ILayer

104 Dim pid As New UID Set pmxdoc = g_spapp.document. Set pmap = pmxdoc.focusmap pid.value = "{EDAD D1-86AE-0000F }" Set penumlayer = pmap.layers(pid, True) penumlayer.reset Set player = penumlayer.next Do While Not player Is Nothing If player.name = strlayername Then Set FindGroupLayer = player Exit Function End If Set player = penumlayer.next Loop End Function ' 根据指定的图层名字查找 Feature 图层 Public Function FindFeatureLayer(iStrLayerName As String) As IFeatureLayer Dim pmap As IMap Dim pmxdoc As IMxdocument. ' 这里用 UID 的方法 Dim penumlayer As IEnumLayer Dim player As ILayer Dim pid As New UID Set pmxdoc = g_spapp.document. Set pmap = pmxdoc.focusmap pid.value = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}" Set penumlayer = pmap.layers(pid, True) penumlayer.reset Set player = penumlayer.next Do While Not player Is Nothing If player.name = istrlayername Then Set FindFeatureLayer = player Exit Function End If Set player = penumlayer.next Loop ' 这里是用层层递进搜索的办法 ' Dim pgrouplayer As igrouplayer ' Dim pcompositelayer As ICompositeLayer ' Dim player As ILayer

105 ' Dim pfeaturelayer As ILayer ' Dim i, j As Integer ' ' Set pmxdoc = g_spapp.document. ' Set pmap = pmxdoc.focusmap ' For i = 0 To pmap.layercount - 1 ' Set player = pmap.layer(i) ' If TypeOf player Is IFeatureLayer Then ' If player.name = istrlayername Then ' Set findfeaturelayer = player ' Exit Function ' End If ' ElseIf TypeOf player Is igrouplayer Then ' Set pcompositelayer = player ' For j = 0 To pcompositelayer.count - 1 ' Set pfeaturelayer = pcompositelayer.layer(j) ' If pfeaturelayer.name = istrlayername Then ' Set findfeaturelayer = pfeaturelayer ' Exit Function ' End If ' Next j ' End If ' Next i End Function ' 保存传入的文件 Public Sub CreateLayerFile(player As ILayer, istrpath As String) Dim pgxlayer As IGxLayer, pfile As IGxFile Set pgxlayer = New GxLayer Set pfile = pgxlayer Set pgxlayer.layer = player pfile.path = istrpath + ".shp" pfile.save pfile.path = istrpath + ".shx" pfile.save pfile.path = istrpath + ".dbf" pfile.save End Sub ' 创建数据库连接, 并进行 SQL 查询 Public Function OpenQuery(connectstr As String, SQLstr As String) As adodb.recordset On Error GoTo ErrPlace

106 Dim m_connect As New adodb.connection Dim m_command As adodb.command Dim mrecordset As adodb.recordset Set m_command = New adodb.command Set m_connect = New adodb.connection m_connect.open connectstr m_command.activeconnection = m_connect m_command.commandtype = adcmdtext m_command.commandtext = SQLstr Set OpenQuery = m_command.execute Set m_connect = Nothing Set m_command = Nothing Exit Function ErrPlace: FrmQuerryCondition.ProgressBarStep.Visible = False FrmQuerryCondition.Label3.Caption = "" Set OpenQuery = Nothing End Function ' 打开记录集 Public Function OpenRec(connectstr As String, SQLstr As String) As adodb.recordset Dim m_connect As adodb.connection Dim mrecordset As adodb.recordset Set m_connect = New adodb.connection Set mrecordset = New adodb.recordset m_connect.open connectstr mrecordset.open SQLstr, m_connect, adopenkeyset, adlockoptimistic Set OpenRec = mrecordset End Function ' 得到半径最大值 Public Function GetMaxNumb(ByRef arr() As Double, ByRef arralfa() As Double) As Double Dim i As Integer Dim j As Integer Dim temp As Double Dim value_i As Double

107 Dim value_j As Double For i = 0 To UBound(arr) - 2 If (arralfa(i) Mod 90 = 0) Then value_i = arr(i) Else value_i = Abs(arr(i) / Cos(arrAlfa(i) * pi / 180)) End If For j = i + 1 To UBound(arr) - 1 If (arralfa(j) Mod 90 = 0) Then value_j = arr(j) Else value_j = Abs(arr(j) / Cos(arrAlfa(j) * pi / 180)) End If If value_i < value_j Then temp = arr(i) arr(i) = arr(j) arr(j) = temp temp = arralfa(i) arralfa(i) = arralfa(j) arralfa(j) = temp End If Next j Next i If (arralfa(0) Mod 90 = 0) Then GetMaxNumb = arr(0) Else GetMaxNumb = Abs(arr(0) / Cos(arrAlfa(0) * pi / 180)) End If End Function ' 根据图层名字显示指定图层 Public Function ShowAppointLayer(strLayerName As String) As Boolean Dim pmap As IMap Dim pmxdoc As IMxdocument. ' 这里用 UID 的方法 Dim penumlayer As IEnumLayer

108 Dim player As ILayer Dim pid As New UID Set pmxdoc = g_spapp.document. Set pmap = pmxdoc.focusmap ' 对 GroupLayer 图层进行操作 ' 设置 GroupLayer 图层为可见 pid.value = "{EDAD D1-86AE-0000F }" Set penumlayer = pmap.layers(pid, True) penumlayer.reset Set player = penumlayer.next Do While Not player Is Nothing player.visible = True Set player = penumlayer.next Loop ' 对 Featurelayer 图层进行操作 pid.value = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}" Set penumlayer = pmap.layers(pid, True) penumlayer.reset Set player = penumlayer.next Do While Not player Is Nothing player.visible = False If player.name = strlayername Then player.visible = True player.minimumscale = 0 End If Set player = penumlayer.next Loop ' 刷新地图 Dim pactiveview As IActiveView Set pactiveview = pmxdoc.activatedview pactiveview.refresh pmxdoc.updatecontents End Function ' 图层控制, 根据字符串树组控制图层的显示状态 Public Function ShowAppointLayers(strLayerName() As String) As Boolean Dim pmap As IMap Dim pmxdoc As IMxdocument. ' 这里用 UID 的方法 Dim penumlayer As IEnumLayer Dim player As ILayer Dim pid As New UID Dim i As Integer

109 Set pmxdoc = g_spapp.document. Set pmap = pmxdoc.focusmap ' 对 GroupLayer 图层进行操作 ' 设置 GroupLayer 图层为可见 pid.value = "{EDAD D1-86AE-0000F }" Set penumlayer = pmap.layers(pid, True) penumlayer.reset Set player = penumlayer.next Do While Not player Is Nothing player.visible = True Set player = penumlayer.next Loop ' 对 Featurelayer 图层进行操作 pid.value = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}" Set penumlayer = pmap.layers(pid, True) penumlayer.reset Set player = penumlayer.next Do While Not player Is Nothing player.visible = False For i = 0 To UBound(strLayerName, 1) If player.name = strlayername(i) Then player.visible = True player.minimumscale = 0 End If Next i Set player = penumlayer.next Loop ' 刷新地图 Dim pactiveview As IActiveView Set pactiveview = pmxdoc.activatedview pactiveview.refresh pmxdoc.updatecontents End Function ' 显示地图范围 Public Function ZoomToEnvlop(pEnvlop As IEnvelope) As Boolean Dim pmap As IMap Dim pmxdoc As IMxdocument. Dim pactiveview As IActiveView Set pmxdoc = g_spapp.document. Set pactiveview = pmxdoc.activatedview If Not penvlop Is Nothing And penvlop.width > 10 Then pactiveview.extent = penvlop pactiveview.refresh End If

110 End Function ' 打开数据库 Public Function OpenConn(pConn As adodb.connection) As Boolean On Error GoTo ErrorHander Dim m_path As String Dim intlastpostion As Integer m_path = App.path intlastpostion = InStrRev(m_path, "\") m_path = Left(m_path, intlastpostion - 1) If pconn.state = adstateopen Then OpenConn = True Exit Function Else pconn.connectionstring = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & m_path & "\SHFIS\Data\ 闵行区 \MHQ.mdb;Persist Security Info=False" 'pconn.mode = admodereadwrite pconn.open End If OpenConn = True Exit Function ErrorHander: MsgBox " 数据库连接失败! 请重新连接!" OpenConn = False End Function AO 画一个多边形 :08:40 大中小 AfterDraw Imports ESRI.ArcGIS.Carto Dim phase As esriviewdrawphase phase = e.viewdrawphase If phase = esriviewdrawphase.esriviewforeground Then Dim pfillsymbol As ISimpleFillSymbol = New SimpleFillSymbol Dim pcolorrgb As IRgbColor = New RgbColor pcolorrgb.rgb = RGB(255, 0, 0) pfillsymbol.color = pcolorrgb pfillsymbol.style = esrisimplefillstyle.esrisfssolid Dim box As ESRI.ArcGIS.Geometry.IEnvelope = New

111 ESRI.ArcGIS.Geometry.Envelope box.putcoords(x, Y, X , Y ) m_mapctrl.drawshape(box, pfillsymbol) End If 调用 AfterDraw : mapctrol.refresh 或者 Me.m_mapctrl.ActiveView.PartialRefresh(ESRI.ArcGIS.Carto.esriViewDrawPhase.esriViewFore ground, Nothing, Nothing) System.Windows.Forms.Application.DoEvents() ' 强制 mapcontrol 即时刷新 AO 画带节点的线 :07:15 大中小 Private Sub DrawLine(ByVal pointsets As SCENELib.line) Try ' 生成线 m_drawline = New ESRI.ArcGIS.Geometry.Polyline Dim geopoint As IPoint Dim ptset As IPointCollection = m_drawline For i As Integer = 1 To pointsets.count() geopoint = New ESRI.ArcGIS.Geometry.Point geopoint.putcoords(pointsets.item(i).x, pointsets.item(i).y) ptset.addpoint(geopoint) ' 顺便画节点, 最后一个为绿色, 其余为蓝色 If i <> pointsets.count Then DrawPoint(pointsets.Item(i), 3, 0, 0, 255) Else DrawPoint(pointsets.Item(i), 3, 0, 255, 0) End If Next ' 画线 Dim plinesymbol As ISimpleLineSymbol plinesymbol = New SimpleLineSymbol Dim pcolorrgb As IRgbColor = New RgbColor pcolorrgb.rgb = RGB(255, 0, 0) plinesymbol.color = pcolorrgb

112 plinesymbol.style = esrisimplelinestyle.esrislssolid ' 线宽度 plinesymbol.width = 1.3 m_mapctrl.drawshape(m_drawline, plinesymbol) Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub DrawPoint(ByVal point As SCENELib.point, ByVal radius As Integer, ByVal R As Integer, ByVal G As Integer, ByVal B As Integer) Try Dim pfillsymbol As ISimpleFillSymbol = New SimpleFillSymbol Dim pcolorrgb As IRgbColor = New RgbColor pcolorrgb.rgb = RGB(R, G, B) pfillsymbol.color = pcolorrgb pfillsymbol.style = esrisimplefillstyle.esrisfssolid Dim x As Integer = point.x Dim y As Integer = point.y m_drawpoint = New ESRI.ArcGIS.Geometry.Envelope m_drawpoint.putcoords(x - pointradiusadd(radius), y - pointradiusadd(radius), x + pointradiusadd(radius), y + pointradiusadd(radius)) m_mapctrl.drawshape(m_drawpoint, pfillsymbol) Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, " 错误提示 ") End Try End Sub AO 计算 Polygon 的面积 :05:44 大中小得到 areapolygon 的面积 : Dim areapolygon As IPolygon = New ESRI.ArcGIS.Geometry.Polygon Dim polyarea As IArea = areapolygon Dim dblarea As Double = polyarea.area 如果 areapolygon 还不存在, 需要把点加入其中, 可以用 IPointCollection: Dim areacollection As IPointCollection = areapolygon For i As Integer = 0 To pointset.pointcount - 1 areacollection.addpoint(pointset.point(i))

113 Next AO 缓冲区查询 :06:19 大中小 ' 需要修改 mousedown 的参数 Private Sub m_map_mousedown(byval eventsender As System.Object, ByVal eventargs As ESRI.ArcGIS.MapControl.IMapControlEvents2_OnMouseDownEvent) Handles m_axmap.onmousedown If Me.Visible Then BufferSelect(eventArgs.x, eventargs.y) End Sub ' 缓冲区查询 Public Sub BufferSelect(ByRef X As Object, ByRef Y As Object) Dim m_bufferwidth As Integer ' 缓冲区宽度 m_bufferwidth = 15 ' 缓冲区宽度 Dim GeoSelect As IGeometry ' 画来用于创建缓冲区的实体 ' 点缓冲 If _optpoint_0.checked = True Then Dim point As ITopologicalOperator = m_map.tomappoint(x, Y) GeoSelect = point.buffer(m_bufferwidth) ' 线 ElseIf _optpoint_1.checked = True Then Dim polyline As ITopologicalOperator = m_map.trackline() GeoSelect = polyline.buffer(m_bufferwidth) ' 圆 ElseIf _optpoint_2.checked = True Then GeoSelect = m_map.trackcircle() ' 矩形 ElseIf _optpoint_3.checked = True Then GeoSelect = m_map.trackrectangle() ' 多边形 ElseIf _optpoint_4.checked = True Then GeoSelect = m_map.trackpolygon() Else Exit Sub End If BufferFind(GeoSelect)

114 End Sub ' 执行查找命令 Private Sub BufferFind(ByRef Buffer As IGeometry) If Buffer Is Nothing Or lstlayer.text = "" Then Exit Sub Me.Cursor = System.Windows.Forms.Cursors.WaitCursor Dim curlayer As IFeatureLayer = m_map.layer(lstlayer.selectedindex) If curlayer Is Nothing Then MsgBox(" 该层已被移出 ") Me.Cursor = System.Windows.Forms.Cursors.Default Exit Sub End If Dim pspatialfilter As ISpatialFilter = New SpatialFilterClass pspatialfilter.geometry = Buffer pspatialfilter.spatialrel = esrispatialrelenum.esrispatialrelintersects Dim pfeatcursor As IFeatureCursor = curlayer.search(pspatialfilter, True) -> 查询结果集 :pfeatcursor m_map.refresh(esriviewdrawphase.esriviewforeground) Me.Cursor = System.Windows.Forms.Cursors.Default End Sub AO 画一个圆 :05:09 Private m_ply As ESRI.ArcGIS.Geometry.IPolygon mousedown: Dim pt As IPoint = New ESRI.ArcGIS.Geometry.Point pt.putcoords(e.mapx, e.mapy) m_ply = Nothing m_ply = MakeCircle(pt, 30000, 2 / 180 * ) AxMapControl1.Refresh() AfterDraw: Imports ESRI.ArcGIS.Carto Private Sub AxMapControl1_OnAfterDraw(...) Handles AxMapControl1.OnAfterDraw Dim phase As esriviewdrawphase phase = e.viewdrawphase If phase = esriviewdrawphase.esriviewforeground Then DrawLine ()

115 End If End Sub DrawLine: Private Sub DrawLine() 实心圆 : If m_ply Is Nothing Then Exit Sub Dim pfillsymbol As ISimpleFillSymbol = New SimpleFillSymbol Dim pcolorrgb As IRgbColor = New RgbColor pcolorrgb.rgb = RGB(255, 0, 0) pfillsymbol.color = pcolorrgb plinesymbol.width = 1.3 pfillsymbol.style = esrisimplefillstyle.esrisfssolid AxMapControl1.DrawShape(m_ply, pfillsymbol) 空心圆 : If m_ply Is Nothing Then Exit Sub Dim plinesymbol As ILineSymbol = New SimpleLineSymbol Dim pcolorrgb As IRgbColor = New RgbColor pcolorrgb.rgb = RGB(255, 0, 0) plinesymbol.color = pcolorrgb plinesymbol.width = 1.3 Dim pfillsymbol As ISimpleFillSymbol = New SimpleFillSymbol pfillsymbol.outline = plinesymbol pfillsymbol.style = esrisimplefillstyle.esrisfshollow AxMapControl1.DrawShape(m_ply, pfillsymbol) End Sub 画一个圆 : Private Function MakeCircle(ByVal cpt As IPoint, ByVal radiu As Double, ByVal dstep As Double) As IPolygon Dim total As Double = 0.0 Dim mycircle As IPolygon = New ESRI.ArcGIS.Geometry.Polygon Dim ptset As IPointCollection = mycircle Dim pt As IPoint = New ESRI.ArcGIS.Geometry.Point While total < * 2 pt.putcoords(cpt.x + radiu * Math.Cos(total), cpt.y + radiu * Math.Sin(total)) ptset.addpoint(pt) total += dstep End While pt.putcoords(cpt.x + radiu, cpt.y) ptset.addpoint(pt) Return mycircle End Function

116 调用 AfterDraw : mapctrol.refresh 或者 Me.m_mapctrl.ActiveView.PartialRefresh(ESRI.ArcGIS.Carto.esriViewDrawPhase.esriViewFore ground, Nothing, Nothing) System.Windows.Forms.Application.DoEvents() ' 强制 maocontrol 即时刷新 AO 查询被选中的实体 :01:30 大中小 Imports ESRI.ArcGIS.Geometry Imports ESRI.ArcGIS.Carto Imports ESRI.ArcGIS.MapControl Imports ESRI.ArcGIS.Display Imports ESRI.ArcGIS.Geodatabase Imports ESRI.ArcGIS.esriSystem Imports ESRI.ArcGIS.DataSourcesGDB Dim mlyr As IFeatureLayer Private mobjsearchshape As IEnvelope = New Envelope Private mrdsselectedfeatures As IFeatureCursor 遍历记录 ' 可以是任何 geometry ' 空间查询结果, 通过该变量来 Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click Dim SelectMethod As Integer ' 组装一个查询边界 mobjsearchshape.setempty() ' 对于一个重复使用的 envelop, 实践证明清空是必 需的, 否则多次使用后会出现坐标值未及时变化的情况 mobjsearchshape.xmin = AxMapControl1.ToMapPoint(0, 0).X mobjsearchshape.ymin = AxMapControl1.ToMapPoint(0, 0).Y mobjsearchshape.xmax = AxMapControl1.ToMapPoint(AxMapControl1.Width, AxMapControl1.Height).X mobjsearchshape.ymax = AxMapControl1.ToMapPoint(AxMapControl1.Width,

117 AxMapControl1.Height).Y Dim curlayer As IFeatureLayer = Nothing curlayer = mlyr If curlayer Is Nothing Then MsgBox(" 该层已被移出 ", vbokonly, " 二维空间查询 ") Exit Sub End If 'todo: 不同的 geometry 有不同的 Method,envelop 才是 esrispatialrelenvelopeintersects SelectMethod = esrispatialrelenum.esrispatialrelenvelopeintersects Dim FtrClass As IFeatureClass = curlayer.featureclass Dim pfilter As ISpatialFilter pfilter = New SpatialFilter With pfilter.geometry = mobjsearchshape.geometryfield = "SHAPE".SpatialRel = SelectMethod End With mrdsselectedfeatures = FtrClass.Search(pFilter, False) Dim pfeature As IFeature = mrdsselectedfeatures.nextfeature Dim a As Integer Do While Not pfeature Is Nothing a += 1 pfeature = mrdsselectedfeatures.nextfeature() Loop MsgBox(a) End Sub AO 绘制带节点橡皮筋线条 :02:52 大中小

118 线及橡皮筋均为红色, 最后节点为绿色, 其余为蓝色, 双击后最后一个节点也变成蓝色 '** ** 'todo: 初始化 : pv = PVswitch.P '** 'todo: 初始化 : m_candraw_byhand = False'** 'todo: 触发 : m_candraw_byhand = True '** '** ** ' Public WithEvents m_mapctrl As AxMapControl Private m_drawobject As ESRI.ArcGIS.Geometry.IGeometry Public m_candraw_byhand As Boolean Private Enum PVswitch P = 0 ' 单击为 P, 双击为 V,PV 机制只在对 AO 实行全程的强制刷新时有效 V = 1 'p->p->v->(clear->)p End Enum ' 二维画图部件对象 Private m_line As IPolyline = New Polyline 'mousemove 时的对象 ( 位于橡皮筋内 ) Dim geostartpoint As IPoint ' 橡皮筋的起始点 (m_line 的终点 ) Dim ptset As IPointCollection 'm_line 的 collection Dim plinesymbol As ISimpleLineSymbol = New SimpleLineSymbol ' 橡皮筋的属性 Dim pcolorrgb As IRgbColor = New RgbColor ' 橡皮筋的属性 Dim line As IPolyline = New ESRI.ArcGIS.Geometry.Polyline ' 传说中的橡皮筋 Private m_geoendpoint As IPoint = New ESRI.ArcGIS.Geometry.Point 'mousemove 时 mouse 的坐标, 也是橡皮筋的后端点 Private pv As PVswitch = New PVswitch Private Sub m_mapctrl_onafterdraw(byval sender As Object, ByVal e As ESRI.ArcGIS.MapControl.IMapControlEvents2_OnAfterDrawEvent) Handles m_mapctrl.onafterdraw Try If m_line Is Nothing Then Exit Sub Dim phase As esriviewdrawphase phase = e.viewdrawphase If phase = esriviewdrawphase.esriviewforeground Then 'todo: 绘制行为, 包括是否绘制橡皮筋 DrawLine(m_Line) If pv = PVswitch.P Then DrawElasticLine() End If End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, " 错误提示 ") End Try

119 End Sub Private Sub m_mapctrl_onmousedown(byval sender As Object, ByVal e As ESRI.ArcGIS.MapControl.IMapControlEvents2_OnMouseDownEvent) Handles m_mapctrl.onmousedown Try If e.button <> 1 Then Exit Sub If m_candraw_byhand = False Then Exit Sub If pv = pv.v Then m_line.setempty() Me.m_mapctrl.ActiveView.PartialRefresh(ESRI.ArcGIS.Carto.esriViewDrawPhase.esriViewFore ground, Nothing, Nothing) System.Windows.Forms.Application.DoEvents() ' 强制 maocontrol 即时刷新 End If Me.m_geoEndPoint.PutCoords(e.mapX, e.mapy) Dim geopoint As IPoint = New ESRI.ArcGIS.Geometry.Point Dim pointset As IPointCollection pointset = m_line geopoint.putcoords(e.mapx, e.mapy) pointset.addpoint(geopoint) 'todo: 获取坐标后的计算行为 'todo: do something pv = PVswitch.P ' 此标志还决定了线条最后一点的颜色, 所以必须在刷新之前执行 Me.m_mapctrl.ActiveView.PartialRefresh(ESRI.ArcGIS.Carto.esriViewDrawPhase.esriViewFore ground, Nothing, Nothing) System.Windows.Forms.Application.DoEvents() ' 强制 maocontrol 即时刷新 Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, " 错误提示 ") End Try End Sub Private Sub m_mapctrl_onmousemove(byval sender As Object, ByVal e As ESRI.ArcGIS.MapControl.IMapControlEvents2_OnMouseMoveEvent) Handles m_mapctrl.onmousemove Try If m_line Is Nothing Then Exit Sub If pv = PVswitch.V Then Exit Sub m_geoendpoint.putcoords(e.mapx, e.mapy) Me.m_mapctrl.ActiveView.PartialRefresh(ESRI.ArcGIS.Carto.esriViewDrawPhase.esriViewFore ground, Nothing, Nothing)

120 System.Windows.Forms.Application.DoEvents() ' 强制 maocontrol 即时刷新 Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub m_mapctrl_ondoubleclick(byval sender As Object, ByVal e As ESRI.ArcGIS.MapControl.IMapControlEvents2_OnDoubleClickEvent) Handles m_mapctrl.ondoubleclick Try If e.button <> 1 Then Exit Sub If pv = PVswitch.V Then Exit Sub If m_candraw_byhand = False Then Exit Sub 'todo: 双击之后的行为 'todo: 注意, 此时不需要再取得点的坐标, 因为双击的时候也出发了单击事件, 点已经取得 'todo: do something pv = PVswitch.V Me.m_mapctrl.ActiveView.PartialRefresh(ESRI.ArcGIS.Carto.esriViewDrawPhase.esriViewFore ground, Nothing, Nothing) System.Windows.Forms.Application.DoEvents() ' 强制 maocontrol 即时刷新 Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, " 错误提示 ") End Try End Sub Private Sub DrawElasticLine() Try ' 生成线 ptset = m_line If ptset Is Nothing Or ptset.pointcount = 0 Then Exit Sub geostartpoint = ptset.point(ptset.pointcount - 1) line.frompoint = geostartpoint line.topoint = m_geoendpoint ' 画线 pcolorrgb.rgb = RGB(255, 0, 0) plinesymbol.color = pcolorrgb plinesymbol.style = esrisimplelinestyle.esrislssolid ' 线宽度 plinesymbol.width = 1.3 m_mapctrl.drawshape(line, plinesymbol) 'todo: 橡皮筋绘制时进行的计算 'do something

121 Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub DrawLine(ByVal pointsets As IPolyline) Dim r, g, b As Integer If pv = PVswitch.P Then r = 0 : g = 255 : b = 0 'green Else r = 0 : g = 0 : b = 255 'blue End If Try ' 生成线 Dim geopoint As IPoint Dim ptset As IPointCollection = pointsets For i As Integer = 0 To ptset.pointcount - 1 ' 顺便画节点, 最后一个为绿色, 其余为蓝色 If i <> ptset.pointcount - 1 Then DrawPoint(ptset.Point(i), 3, 0, 0, 255) Else DrawPoint(ptset.Point(i), 3, r, g, b) End If Next ' 画线 Dim plinesymbol As ISimpleLineSymbol plinesymbol = New SimpleLineSymbol Dim pcolorrgb As IRgbColor = New RgbColor pcolorrgb.rgb = RGB(255, 0, 0) plinesymbol.color = pcolorrgb plinesymbol.style = esrisimplelinestyle.esrislssolid ' 线宽度 plinesymbol.width = 1.3 m_mapctrl.drawshape(pointsets, plinesymbol) Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub DrawPoint(ByVal point As IPoint, ByVal radius As Integer, ByVal R As Integer, ByVal G As Integer, ByVal B As Integer) Try Dim pfillsymbol As ISimpleFillSymbol = New SimpleFillSymbol Dim pcolorrgb As IRgbColor = New RgbColor

122 pcolorrgb.rgb = RGB(R, G, B) pfillsymbol.color = pcolorrgb pfillsymbol.style = esrisimplefillstyle.esrisfssolid Dim m_drawpoint As IEnvelope Dim x As Integer = point.x Dim y As Integer = point.y m_drawpoint = New ESRI.ArcGIS.Geometry.Envelope m_drawpoint.putcoords(x - pointradiusadd(radius), y - pointradiusadd(radius), x + pointradiusadd(radius), y + pointradiusadd(radius)) m_mapctrl.drawshape(m_drawpoint, pfillsymbol) Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, " 错误提示 ") End Try End Sub Private Function pointradiusadd(byval Radius As Double) As Double Try Dim geopoint As IPoint = New ESRI.ArcGIS.Geometry.Point geopoint = m_mapctrl.tomappoint(0, 0) Dim y1, y2 As Integer y1 = geopoint.y geopoint = m_mapctrl.tomappoint(radius, Radius) y2 = geopoint.y Return System.Math.Abs(y1 - y2) Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, " 错误提示 ") End Try End Function 清除所有线条 : Private m_drawingpencollection As Collection = New Collection Private Sub ClearMap() Try ' 把所有用过的画笔都加入到 collection 中去 m_drawingpencollection.add(m_line) m_drawingpencollection.add(line) If m_drawingpencollection Is Nothing Then Exit Sub Dim geoobject As ESRI.ArcGIS.Geometry.IGeometry For i As Integer = 1 To m_drawingpencollection.count If Not m_drawingpencollection.item(i) Is Nothing Then

123 geoobject = CType(m_DrawingPenCollection.Item(i), ESRI.ArcGIS.Geometry.IGeometry) geoobject.setempty() End If Next m_drawingpencollection = New Collection Me.m_mapctrl.ActiveView.PartialRefresh(ESRI.ArcGIS.Carto.esriViewDrawPhase.esriViewFore ground, Nothing, Nothing) System.Windows.Forms.Application.DoEvents() ' 强制 maocontrol 即时刷新 Catch ex As Exception MsgBox(" 画笔清空错误 :" & ex.message, MsgBoxStyle.Critical, " 错误提示 ") End Try End Sub AO 绘制橡皮筋多边形 :03:37 大中小 '** ** 'todo: 初始化 : pv = PVswitch.P '** 'todo: 初始化 : m_candraw_byhand = False'** 'todo: 触发 : m_candraw_byhand = True '** '** ** ' Public WithEvents m_mapctrl As AxMapControl Private m_drawobject As ESRI.ArcGIS.Geometry.IGeometry Public m_candraw_byhand As Boolean Private Enum PVswitch P = 0 ' 单击为 P, 双击为 V,PV 机制只在对 AO 实行全程的强制刷新时有效 V = 1 'p->p->v->(clear->)p End Enum ' 二维画图部件对象 Private m_line As IPolyline = New Polyline 'mousemove 时的对象 ( 位于橡皮筋内 ) Dim ptset As IPointCollection 'm_line 的 collection Private m_geoendpoint As IPoint = New ESRI.ArcGIS.Geometry.Point 'mousemove 时 mouse 的坐标, 也是橡皮筋的后端点 Private pv As PVswitch = New PVswitch Private Sub m_mapctrl_onafterdraw(byval sender As Object, ByVal e As

124 ESRI.ArcGIS.MapControl.IMapControlEvents2_OnAfterDrawEvent) Handles m_mapctrl.onafterdraw Try Dim phase As esriviewdrawphase phase = e.viewdrawphase If phase = esriviewdrawphase.esriviewforeground Then If m_line.isempty = True Then Exit Sub Dim polygoncollection As IPointCollection = m_polygon polygoncollection.removepoints(polygoncollection.pointcount - 1, 1) If pv = PVswitch.P Then polygoncollection.addpoint(m_geoendpoint) End If Dim plinesymbol As ILineSymbol = New SimpleLineSymbol Dim pcolorrgb As IRgbColor = New RgbColor pcolorrgb.rgb = System.Drawing.ColorTranslator.ToOle(Me.buttonColor.BackColor) plinesymbol.color = pcolorrgb plinesymbol.width = LINEWIDTH Dim pfillsymbol As ISimpleFillSymbol = New SimpleFillSymbol pfillsymbol.outline = plinesymbol pfillsymbol.style = esrisimplefillstyle.esrisfshollow m_mapctrl.drawshape(m_polygon, pfillsymbol) End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, " 错误提示 ") End Try End Sub Private Sub m_mapctrl_onmousedown(byval sender As Object, ByVal e As ESRI.ArcGIS.MapControl.IMapControlEvents2_OnMouseDownEvent) Handles m_mapctrl.onmousedown Try If e.button <> 1 Then Exit Sub If m_candraw_byhand = False Then Exit Sub If pv = pv.v Then ClearMap() End If Me.m_geoEndPoint.PutCoords(e.mapX, e.mapy) Dim geopoint As IPoint = New ESRI.ArcGIS.Geometry.Point Dim pointset As IPointCollection pointset = m_line geopoint.putcoords(e.mapx, e.mapy) pointset.addpoint(geopoint) ' 需要加两次, 最后一个点会在

125 mousemove 的时候被橡皮筋替代掉 pointset.addpoint(geopoint) Dim PolygonCollection As IPointCollection = m_polygon m_polygon.setempty() For i As Integer = 0 To pointset.pointcount - 1 PolygonCollection.AddPoint(pointset.Point(i)) Next pv = PVswitch.P ' 此标志还决定了线条最后一点的颜色, 所以必须在刷新之前执行 m_mapctrl.refresh() System.Windows.Forms.Application.DoEvents() ' 强制 maocontrol 即时刷新 Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, " 错误提示 ") End Try Private Sub m_mapctrl_onmousemove(byval sender As Object, ByVal e As ESRI.ArcGIS.MapControl.IMapControlEvents2_OnMouseMoveEvent) Handles m_mapctrl.onmousemove Try If m_line Is Nothing Then Exit Sub If pv = PVswitch.V Then Exit Sub m_geoendpoint.putcoords(e.mapx, e.mapy) m_mapctrl.refresh() System.Windows.Forms.Application.DoEvents() ' 强制 maocontrol 即时刷新 Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub m_mapctrl_ondoubleclick(byval sender As Object, ByVal e As ESRI.ArcGIS.MapControl.IMapControlEvents2_OnDoubleClickEvent) Handles m_mapctrl.ondoubleclick Try If e.button <> 1 Then Exit Sub If pv = PVswitch.V Then Exit Sub If m_candraw_byhand = False Then Exit Sub pv = PVswitch.V m_mapctrl.refresh() System.Windows.Forms.Application.DoEvents() ' 强制 maocontrol 即时刷新 Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, " 错误提示 ") End Try End Sub

126 AO 绘制缓冲区 :04:40 大中小 Imports ESRI.ArcGIS.Geometry Imports ESRI.ArcGIS.Carto Imports ESRI.ArcGIS.MapControl Imports ESRI.ArcGIS.Display Public Class Form1 Inherits System.Windows.Forms.Form 窗体代码 Dim m_line As IPolyline = New Polyline Dim buffer As IGeometry Private Sub AxMapControl1_OnMouseDown(ByVal sender As System.Object, ByVal e As ESRI.ArcGIS.MapControl.IMapControlEvents2_OnMouseDownEvent) Handles AxMapControl1.OnMouseDown Dim pt As IPoint = New ESRI.ArcGIS.Geometry.Point pt.putcoords(e.mapx, e.mapy) Dim coll As IPointCollection coll = m_line coll.addpoint(pt) AxMapControl1.Refresh() System.Windows.Forms.Application.DoEvents() ' 强制 maocontrol 即时刷新 End Sub Private Sub AxMapControl1_OnAfterDraw(ByVal sender As Object, ByVal e As ESRI.ArcGIS.MapControl.IMapControlEvents2_OnAfterDrawEvent) Handles AxMapControl1.OnAfterDraw ' 画线 If m_line Is Nothing Then Exit Sub Dim plinesymbol As ISimpleLineSymbol plinesymbol = New SimpleLineSymbol Dim pcolorrgb As IRgbColor = New RgbColor pcolorrgb.rgb = RGB(255, 0, 0) plinesymbol.color = pcolorrgb plinesymbol.style = esrisimplelinestyle.esrislssolid

127 plinesymbol.width = 1 AxMapControl1.DrawShape(m_Line, plinesymbol) ' 画缓冲区 Dim GeoSelect As IGeometry ' 画来用于创建缓冲区的实体 ' 点缓冲 Dim point As ITopologicalOperator = m_line GeoSelect = point.buffer(50) Dim pfillsymbol As ISimpleFillSymbol = New SimpleFillSymbol pcolorrgb.rgb = RGB(255, 0, 0) pfillsymbol.color = pcolorrgb pfillsymbol.style = esrisimplefillstyle.esrisfscross Dim box As ESRI.ArcGIS.Geometry.IEnvelope = New ESRI.ArcGIS.Geometry.Envelope AxMapControl1.DrawShape(GeoSelect, pfillsymbol) End Sub End Class vb+ao 鹰眼图代码 :18:13 大中小 Dim pmainmap As IMap Dim pmainav As IActiveView Dim povermap As IMap Dim poverav As IActiveView Dim povergracon As IGraphicsContainer Dim penv As IEnvelope Private Sub Form_Load() Set pmainmap = MapControl1.Map Set pmainav = pmainmap Set povermap = MapControl2.Map Set poverav = povermap Set povergracon = poverav poverav.extent = MapControl2.FullExtent

128 poverav.partialrefresh esriviewdrawphase.esriviewgeography, Nothing, Nothing End Sub Private Sub MapControl1_OnAfterScreenDraw(ByVal hdc As Long) ' 两个控件保持保持一致 Set penv = pmainav.extent Dim poverele As IFillShapeElement Set poverele = getenvele(penv) povergracon.deleteallelements povergracon.addelement poverele, 0 ' 刷新鸟瞰控件视图 poverav.partialrefresh esriviewdrawphase.esriviewgeography, Nothing, Nothing End Sub Private Sub MapControl2_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapx As Double, ByVal mapy As Double) Dim ppt As IPoint Set ppt = New Point ppt.putcoords mapx, mapy ' 改变主控件的视图范围 penv.centerat ppt pmainav.extent = penv pmainav.partialrefresh esriviewdrawphase.esriviewgeography, Nothing, Nothing End Sub ' 产生颜色的函数 Private Function getenvele(byval penv As IEnvelope) As IFillShapeElement Dim pele As IElement Dim pfillshapeele As IFillShapeElement Set pfillshapeele = New RectangleElement Set pele = pfillshapeele ' 颜色产生器 Dim pcolor As IRgbColor Set pcolor = New RgbColor pcolor.red = 255

129 pcolor.green = 0 pcolor.blue = 0 pcolor.transparency = 255 ' 线符号 Dim plinesym As ISimpleLineSymbol Set plinesym = New SimpleLineSymbol plinesym.color = pcolor plinesym.style = esrisimplelinestyle.esrislssolid plinesym.width = 1 ' 填充符号 Dim pfillsym As IFillSymbol Set pfillsym = New SimpleFillSymbol pcolor.transparency = 0 pfillsym.color = pcolor pfillsym.outline = plinesym pele.geometry = penv pfillshapeele.symbol = pfillsym Set getenvele = pfillshapeele 'Return pfillshapeele End Function 如何利用 ao 编辑 shape 文件的某个属性的属性值 :49:11 我在 arcgisworld 论坛里看到的, 属性字段的批量转换 im pfeatcurnew As IFeatureCursor Dim pfieldsnew As IFields Dim lfldgeocodenew As Long, lfldcadhandlenew As Long Dim pfeatnew As IFeature Dim lloop As Long Set pfieldsnew = psdefc.fields lfldgeocodenew = pfieldsnew.findfield("geocode") lfldcadhandlenew = pfieldsnew.findfield("cadhandle") Set pfeatcurnew = psdefc.search(nothing, False)

130 Set pfeatnew = pfeatcurnew.nextfeature Do While Not pfeatnew Is Nothing lloop = lloop + 1 pfeatnew.value(lfldgeocodenew) = sattlist(lloop - 1, 0) pfeatnew.value(lfldcadhandlenew) = sattlist(lloop - 1, 1) pfeatnew.store Set pfeatnew = pfeatcurnew.nextfeature Loop MO 作为 B/S 客户端控件的开发 :14:59 转载开发 GIS 与 OA 一体化系统时,OA 中经常需要使用图形的浏览 查询等功能, 这在 OA 系统采用 C/S 模式的情况下, 并不困难, 但在采用 B/S 架构时, 却往往不知从何下手 一般的做法时采用 ArcIMS 等软件作为服务器端软件进行开发, 但这些软件需要额外购买, 很不划算 其实我们将 MO 作为一个 ActiveX 控件插入到网页中, 用 javascript 进行控制, 也可以实现非常强大的功能 下面举一个例子, 可以实现加载图层, 放大, 缩小和平移功能 <html> <head> <meta http-equiv="content-language" content="zh-cn"> <meta http-equiv="content-type" content="text/html; charset=gb2312"> <meta name="generator" content="microsoft FrontPage 4.0"> <meta name="progid" content="frontpage.editor.document"> <title>new Page 1</title> </head> <body> <SCRIPT language=javascript> var MapState = 0; function LoadLayers() { Map1.ScrollBars = false; var dc = new ActiveXObject("MapObjects2.DataConnection") dc.server = "sde81:server";

131 dc.database = "esri_sde"; dc.user="sa"; dc.password = "sa"; if (dc.connect() == false) { return; } var gs; gs = dc.findgeodataset("sde.dbo.zd#1.shape.polygons"); if (gs == null) return; var ly = new ActiveXObject("MapObjects2.MapLayer"); ly.geodataset = gs; Map1.Layers.Add(ly); Map1.Refresh(); } </script> <script language = "javascript" for = "Map1" event = "MouseDown(Button,Shift,X,Y)"> if (MapState == 0) { Map1.Extent = Map1.TrackRectangle(); } else if(mapstate ==1) { var rect; rect=map1.extent(); rect.scalerectangle(1.3); Map1.Extent = rect; } else if(mapstate == 2) { Map1.Pan(); } </script> <script language = "javascript" for = "Map1" event = "MouseMove(Button,Shift,X,Y)"> if (MapState == 0) { Map1.MousePointer = 51; }

132 else if(mapstate ==1) { Map1.MousePointer = 52; } else if(mapstate == 2) { Map1.MousePointer = 53; } </script> <p> <object classid="clsid:9bd6a64b-ce75-11d1-af04-204c4f4f5020" id="map1" width="572" height="452"> <param name="_version" value="131072"> <param name="_extentx" value="15134"> <param name="_extenty" value="11959"> <param name="_stockprops" value="225"> <param name="backcolor" value=" "> <param name="borderstyle" value="1"> <param name="enabled" value="1"> <param name="appearance" value="0"> <param name="scrollbars" value="1"> <param name="refreshcount" value="10000"> <param name="cancelaction" value="1"> <param name="windowmode" value="0"> <param name="minwidth" value="0"> <param name="mousepointer" value="0"> <param name="borderstyle" value="1"> <param name="backcolor" value=" "> <param name="fullredrawonpan" value="0"> </object> </p> <p> <input type="button" value="loadlayer" name="b3" onclick = "LoadLayers()"> <input type="button" value="zoom In" name="b5" onclick = "javscript:mapstate=0"> <input type="button" value="zoom Out" name="b6" onclick = "javscript:mapstate=1"> <input type="button" value="pan" name="b4" onclick = "javscript:mapstate=2"> </p> <p>

133 </body> </html> MO 作为 B/S 服务器端的开发 :13:01 大中小转载本人从事 MO 开发有近两年, 现在已经转向 ArcGis Engine 和 ArcGis Server 的开发 MO 作为引导我进入 GIS 殿堂这样的一个 GIS 组件, 我花在它上面的心血确实太多了 回忆起以前用 MO 实现符号化, 实现自定义出图, 实现投影, 实现空间分析等功能所经历过酸甜苦辣, 真是爱恨交加, 感慨万千 现在我要告别 MO 了, 于是我陆陆续续地写了一些小文在讲述我所做过的一些东西, 以便我对这一段开发的历史还有所记忆 本文会是我写的最后一篇关于 MO 的文章了 前面写了一篇 MO 作为 B/S 客户器端的开发的小文, 其实 MO 还可以作为 B/S 服务器端的 GIS 支持平台 要实现初级的功能如获取地图是比较简单的, 但要实现复杂功能的话, 那就要花太多精力了, 最后可能会得不偿失, 建议采用 ArcIMS 或 ArcGis Server 之类的平台 好了, 废话少说, 现在我们来看一看怎么样用 MO 实现一个简单的地图获取功能 原理 : 在服务器端运行一个服务程序, 该程序要有一个地图控件, 并且设置好加载的图层以及符号化效果, 然后打开一个端口并监听, 如果收到请求, 则在服务器的一个临时目录下生成一个临时图片文件 ( 如果各位有兴趣, 我想可以做成一个 WebService, 这样适应能力更强, 扩展性也好 ) 网页是能过 Asp.net 生成的, 网页上有一个 Image 组件, 现在程序要做的是只是获取这个图片的 URL, 然后将其赋给 Image 组件的 ImageUrl 属性就可以了 第一步 : 服务程序的开发 开发工具 :VB 步骤 : 首先在 Form 上放在一个 Map 组件和一个 Winsock 组件, 然后在 Form_Load 中写下代码 : With WinSock1.RemoteHost = " ".RemotePort = 4001.Bind 4002 End With 并在 Form_Load 中进行地图的初始化 : 加载图层, 以及符号化等

134 然后在 Winsock1 的 Data_Arrival 事件中, 接收客户端的请求 ( 实际是经过 Asp.net 处理过的, 也就是说 WinSock 收到的数据是在服务器端发送的 ) Data_Arrival 的代码大致是这样的 : Dim strdata() As Byte Dim strrequest As String Winsock1.GetData strdata strrequest = CStr(strData) ///// 下面根据 strrequest 对地图进行处理, 并生成图片 Dim strfile as String // 根据需求按一定规则生成一个文件名... Map1.ExportJpeg(strFile); 第二步 : 在网页中, 请求生成图片, 并显示出来 开发工具 :Asp.net,C# 首先, 发送请求, 请求的内容为一个字符串 : ShowLoading(); UdpClient udpclient = new UdpClient(); Byte[] sendbytes = Encoding.ASCII.GetBytes(strRequest); try{ udpclient.send(sendbytes, sendbytes.length, HostIP, 4002); } 服务器收到请求, 会成一个图片文件, 假设文件的 URL 地址为 strurl, 现在将这个文件显示在浏览器中 Image1.ImageUrl = strurl; HideLoading(); 经过这几步之后, 浏览器就可以看到服务器端 MO 生成的图片了 上面是一个简单的例子, 还可以扩展出比较强的功能, 但工作量会比较大 如果要进行扩展, 我认为还要做好以下几个工作 : 1 定义一个服务器与客户端交互的规范, 就像 ArcIMS 中通过规格定式的 ArcXML 来交互一样 ; 2 确定服务器端的采用的技术, 是 DCOM, 还是 WebService 等, 确定服务该如何提供 上面例子中方式应该来说还是很不完善的 ; 3 定义一种地图的工程文件, 像 ArcGis Desktop 的 MXD 文件, 或是 ArcIMS 中的 axl 文件 总之这种文件能够定义地图的图层及显示效果等, 你的程序必须能够加载种文件 主要就是这几条吧 我也没有偿试去做, 因为我现在不需要用它了 ~ 呵呵

135 两点间画线 :57:11 大中小 Dim ppointcol As IPointCollection Private Sub DrawLine_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long) On Error GoTo err: Dim pmxdoc As IMxDocument Dim pactiveview As IActiveView Dim pscreendisplay As IScreenDisplay Dim prubberline As IRubberBand Dim plinesymbol As ISimpleLineSymbol Dim prgbcolor As IRgbColor Dim ppoint As IPoint Dim pmarksymbol As ISimpleMarkerSymbol Set pmxdoc = Application.Document Set pactiveview = pmxdoc.focusmap Set pscreendisplay = pactiveview.screendisplay Set prubberline = New RubberPoint Set plinesymbol = New SimpleLineSymbol Set prgbcolor = New RgbColor prgbcolor.green = 255 plinesymbol.color = prgbcolor Set pmarksymbol = New SimpleMarkerSymbol pmarksymbol.color = prgbcolor pmarksymbol.size = 5 pmarksymbol.style = esrismscross Set ppoint = prubberline.tracknew(pscreendisplay, plinesymbol) ppointcol.addpoint ppoint 'Debug.Print ppointcol.pointcount If ppointcol.pointcount = 2 Then Dim ppoline As IPolyline Set ppoline = ppointcol With pscreendisplay.startdrawing pscreendisplay.hdc, esrinoscreencache.setsymbol plinesymbol

136 .DrawPolyline ppoline.drawpoint ppoint.finishdrawing End With Debug.Print "Start Point: X =" & ppointcol.point(0).x & _ " Y =" & ppointcol.point(0).y Debug.Print "End Point: X =" & ppointcol.point(1).x & _ " Y =" & ppointcol.point(1).y ppointcol.removepoints 0, 2 End If With pscreendisplay.startdrawing pscreendisplay.hdc, esrinoscreencache.setsymbol pmarksymbol.drawpoint ppoint.finishdrawing End With Exit Sub err: MsgBox "cuowu" End Sub Private Sub DrawLine_Select() Set ppointcol = New Polyline End Sub 创建 Personal Geodatabase :41:03 大中小创建 Personal Geodatabase Private Sub newgeodatabase_click() Dim pfeaturedataset As IGxDataset Dim pgxdialog As IGxDialog Dim pgxcatalog As IGxCatalog Set pgxdialog = New GxDialog Dim pgxobject As IGxObject

137 Dim PGName As String, PathName As String With pgxdialog.allowmultiselect = False Set.ObjectFilter = New GxFilterPersonalGeodatabases.DoModalSave ThisDocument.Parent.hWnd ', Nothing Set pgxcatalog =.InternalCatalog.Title = " 创建个人 Geodatabase" PGName = pgxdialog.name Set pgxobject =.FinalLocation End With PathName = pgxobject.fullname Call createaccessworkspace(pathname, PGName) 调用函数 End Sub 函数 createaccessworkspace Public Function createaccessworkspace(location As String, Name As String) As esricore.iworkspacename On Error GoTo EH Set createaccessworkspace = Nothing ' create the Access Workspace factory Dim pworkspacefactory As IWorkspaceFactory Set pworkspacefactory = New esricore.accessworkspacefactory Dim pworkspacename As esricore.iworkspacename Set pworkspacename = pworkspacefactory.create(location, Name, Nothing, 0) Set createaccessworkspace = pworkspacename Exit Function EH: MsgBox Err.Number, vbinformation, "createaccessworkspace" End Function 发表文章 ArcObject 学习的重要工具 --Object Model Diagrams :31:09 大中小

138 ArcObject 是以一组的基础的类库组成的, 在使用这些类的时候经常可能会发现这样那样的问题, 比如 : 1) 不知道到底应该使用那个类来操作 ; 2) 有的时候使用某个类的时候会出现有的类不能实例化而有的类又不能直接定义而必须从某个实例中初始化而得到 ; 实际应用中我们有一些工具可以使用 :Object Model Diagrams,ArcObjects Developer Help System,ESRI s object browser(eobrowser) 其中 ArcObjects Developer Help System 和 EOBrowser 可能大家用得也比较多, 但是 Object Model Diagrams 可能就用得不多, 不太注意 其实 Object Model Diagrams 是 ArcObjects 学习和使用很有用的工具, 通过这些图可以更好的理解各种类之间的关联, 结合 COM 的知识, 可以加深对 ArcObject 的认识, 是对其的使用更高效 下面首先结合图说一下 Object Model Diagrams 中的一些概念 :