ArcGIS Engine开发FAQ

xtipuge 贡献于2012-01-11

作者 LZH  创建于2011-07-29 05:35:00   修改者Administrator  修改于2011-07-29 05:35:00字数140462

文档摘要:用ArcGIS Engine开发的一个特别就是面向接口编程,每组接口代表了对象在某个方面的特性,表现为一个方法、属性或事件。要定义自己的图层类型,实际上只需要实现ILayer接口就可以了。
关键词:

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 如何在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方法介绍 100 AO基本函数集合(很多函数功能) 103 AO画一个多边形 110 AO画带节点的线 111 AO计算Polygon的面积 112 AO缓冲区查询 113 AO画一个圆 114 AO查询被选中的实体 116 AO绘制带节点橡皮筋线条 117 AO绘制橡皮筋多边形 123 AO绘制缓冲区 126 vb+ao鹰眼图代码 127 如何利用ao编辑shape文件的某个属性的属性值 129 MO作为B/S客户端控件的开发 130 MO作为B/S服务器端的开发 133 两点间画线 135 创建Personal Geodatabase 136 ArcObject学习的重要工具--Object Model Diagrams 137 ArcObject学习的重要工具--Object Model Diagrams (二) 139 AO开发感想 141 AO中的组件库(1) 143 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。当我们保存文档,使用了保存缩略选项时,会在文档中保存一个缩略图。我们可以通过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")             {                 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。 如果一个虚拟目录已经被指定,确认它是有效的,并且看上去和下面的格式一样, http:///output 4 如果有错请更改,然后重新创建server object来确认更改是否有效。  错误描述 当在Visual Studio.NET 2003上使用ArcGIS Server .NET 的ADF模板创建一个项目时,返回如下错误信息: “在服务器<主机名>上的Web站点不可用(Web Site on server is not available)” 导致原因 该模板包含了调用'http://localhost'这一URL的属性。如果在IIS中禁用了本地主机的服务,则显示该错误信息。禁用本地服务可能是因为你的Web站点已经为其指定了一个IP地址或者是因为安全方面的考虑。 解决办法 启用对 http://localhost的访问决定于您安装的是哪种类型的操作系统,是服务器还是非服务器。 对于非服务器的操作系统: 1.点击Internet信息服务控制台,右键选择默认站点的属性,打开属性对话框,并选择网站标签页。 2.修改IP地址栏为"(全部未分配)"。 3.重启IIS。 在IE浏览器中浏览刚刚启用的 http://localhost 服务,在Visual Studio .NET 2003 中用模板创建项目,现在应该是成功的了。 对于Windows Server操作系统: 1. 在Internet信息服务控制台上创建一个新的Web站点。 2. 为其分配IP地址:127.0.0.1。意味着只能在本地计算机上启用该站点。 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,关闭属性对话框. 错误描述 使用下面的代码,来进行使用字体中的符号进行点要素渲染的时候,会出现地图消失的问题。 下面的代码是用来生成需要在渲染过程中使用的点符号的,使用的是宋体中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 ; IStyleGalleryStorage pSGStorage = pSGallery as IStyleGalleryStorage ; pSGStorage.TargetFile = @"D:\xjw.ServerStyle"; 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 -2147221164: COM object with CLSID {4FEDC9CB-A7BE-11D5-B2A0-00508BCDDE28} 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支持选项被选中。 错误描述 当使用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-6487-47AE-AF1D-7AF6088EEBDB}. HRESULT: -2147024894." 之后点击'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 文件设置改回来,以重新激活数据执行保护的安全选项。 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 ArcCatalog 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 layer's DataSourceType to any string. Here is a list of default values for DataSourceType for common feature layer types: Layer Type Value Personal Geodatabase "Personal Geodatabase Feature Class" SDE "SDE Feature Class" Shapefile "Shapefile Feature Class" ArcInfo or PC ArcInfo Coverage (annotation) "Annotation Feature Class" 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'" '进行查询: Dim pFeatureCursor As IFeatureCursor Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False) Dim pFeature As IFeature Set pFeature = pFeatureCursor.NextFeat ure 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版本的话就不可以预先创建这样的一个高程字段,而是在生成等高线过程中根据你指定的 '字段名称实时创建 Dim pPropset As IPropertySet Set pPropset = New PropertySet Dim pFact As I WorkspaceFactory 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) 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 编号: 000484 相关产品及版本: ArcInfo Desktop,ArcGIS Engine Developer Kit,ArcGIS Engine Runtime  90 平台: PC-Intel Windows2000 提交时间: 2005-07-01   修改时间: 2005-07-01 提交人: 黄齐飞 内容摘要 使用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 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 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 p PtZAware = Nothing Set Pt = Nothing End Sub  在AO或者ENGINE中为SHAPEFILE添加SPATIAL INDEX 编号: 000390 相关产品及版本: ArcInfo Desktop,ArcGIS Engine Developer Kit  8.3,9.0,9.1 平台: N/A 提交时间: 2005-04-21   修改时间: 2005-04-21 提交人: 许春杰 内容摘要 在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 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控件中(进行相关操作) 编号: 000791 相关产品及版本: ArcGIS Engine Developer Kit,ArcGIS Engine Runtime  9.0、9.1 平台: win 提交时间: 2006-07-31   修改时间: 2006-07-31 提交人: 谭军辉 内容摘要 把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         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             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生成等值线源码  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        E nd 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        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 = 20360000     xmax = 20550000     ymin = 4340000     ymax = 4557000         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         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     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         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     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)     '  ' 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 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 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定义时只能找到面而不能找到点和线的问题 编号: 000082 相关产品及版本: ArcGIS Engine Developer Kit  ArcEngine 平台: N/A 提交时间: 2004-09-17   修改时间: 2004-09-20 提交人: 谭军辉 内容摘要 过程描述 问题:当用定义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) '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 ide ntified." End If 使用ArcGIS Engine来实现地图的点击查询并闪烁 编号: 000300 相关产品及版本: ArcGIS Engine Developer Kit,ArcGIS Engine Runtime  9.0 平台: N/A 提交时间: 2005-03-25   修改时间: 2005-03-25 提交人: 朱政 内容摘要 ArcGIS Engine没有提供在MapControl中点击查询的命令,只是提供了ReaderControl中的使用的点击查询的命令,下面的代码就是实现点击查询并闪烁的代码。 过程描述 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 空间查询的实现 编号: 000307 相关产品及版本: ArcGIS Engine Developer Kit,ArcGIS Engine Runtime  9.0 平台: N/A 提交时间: 2005-03-28   修改时间: 2005-03-28 提交人: 朱政 内容摘要 空间查询是一个经常要用到的功能,它是通过给定一定的范围,查询得到在这个空间范围内的要素的查询方式。下面的代码是在返回鼠标点击点周围长宽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 .SpatialRel = esriSpatialRelIntersects End With Dim b As Boolean b = pSFilter.FilterOwnsGeometry Dim pFeatureCursor As IFeatureCursor Set pFeatureCursor = pFeatureLayer.Search(pSFilter, False) 如何在同一图层中做缓冲选择 编号: 000040 相关产品及版本: ArcIMS  ArcIMS 4.0.1 9.0 平台: N/A 提交时间: 2004-08-24   修改时间: 2004-08-24 提交人: 张在荣 内容摘要 在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); fLayer.setFilterObject(filter); 5.查询结果被保存在一个名称为'bufferLayer'的层中。 FeatureLayer resultLayer=null; Recordset recordset = null; for (int i=0;iTopology,点击下一步。 2.在接下来的步骤中输入拓扑类的名称,并输入一个容限值。容限是一个距离范围,在这个范围内节点被认为是重叠的。在拓扑验证过程中,落入群组容限的节点和端点会被捕捉。 3.点击下一步,选择参与拓扑的featureclass 4.点击下一步,可以为每一个featureclass输入等级,等级低的会被捕捉到等级高的featureclass中去(等级越高,越不会被移动)。 5.点击下一步,可以为拓扑增加拓扑规则。拓扑规则可以为一个要素中的要素定义,也可以为两个或两个以上要素类间的要素定义。比如规则包括:多边形不能重叠;不能有悬线(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数据库现象? 编号: 000618 相关产品及版本: ArcInfo Desktop  9.0,9.1 平台: N/A 提交时间: 2005-11-28   修改时间: 2005-11-28 提交人: 许春杰 问题 shapefile和coverage出现无法导入SDE数据库,导入过程中出现,Underlying DBMS error,ORA-00911: 无效字符 错误。出现该错误的原因是源文件的字段名中出现了像$,#等无效字符。 解答 在SDE中新建一个FEATURE CLASS,然后将源数据的SPATAIL REFERENCE导入,将字段定义也导入,导入字段定义的时候你可以修改字段,去掉"、$"之类不规则的字符。建完FEATURE CLASS后再右键点击您的要素类,选择LOAD DADA,选择源SHAPE文件或者源CONVERAGE,会出来对话框如何进行字段映射,设置完成后即可将数据导入。 怎么显示布局控件的标尺 编号: 000310 相关产品及版本: ArcGIS Engine Developer Kit  2000 平台: PC-Intel Windows2000 提交时间: 2005-03-28   修改时间: 2005-03-28 提交人: 黄齐飞 内容摘要 使用如下代码在ArcEngine中显示不出来布局控件的标尺: Private Sub Command1_Click() PageLayoutControl1.PageLayout.RulerSettings.SmallestDivision = 2 PageLayoutControl1.ActiveView.ShowRulers = True PageLayoutControl1.Refresh End Sub 过程描述 在ArcEngine中没有标尺对象。可以使用VC++编写。 把shapefile polygons转为polylines 编号: 000057 相关产品及版本: ArcInfo Desktop,ArcEditor,ArcView  8.x, 9.0 平台: PC-Intel Windows 提交时间: 2004-08-26   修改时间: 2004-08-26 提交人: 朱华岚 内容摘要 本文显示了如何在ArcCatalog和ArcMap中把shapefile的polygon边界转为polyline。 过程描述 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属性表或添加字段? 编号: 000428 相关产品及版本: ArcInfo Desktop,ArcEditor  8.1,8.2,8.3,9.0 平台: PC-Intel Windows 提交时间: 2005-05-08   修改时间: 2005-05-08 提交人: 林雪淋 问题 为什么不能编辑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,请参考http://arcgisdeveloperonline.esri.com。里边的DataSourcesRaster库是这个主题的好资源。 如果仅仅是为了显示,那么可以通过以下步骤添加字段到raster层的属性表: 1。右击ArcMap内容表中的raster层。 2。指向Joins and Relates。 3。点Join。 4。根据对话框的向导完成。  使用ArcGIS将GTOPO30 DEM数据转换到栅格数据 编号: 000345 相关产品及版本: ArcInfo Desktop  8.2, 8.3, 9.0 平台: N/A 提交时间: 2005-04-06   修改时间: 2005-04-06 提交人: 文杰 内容摘要 可以使用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] - 65536,[in_grid]) 点击Evaluate. 12. 使用SETNULL功能可以将海洋区域(-9999)转换为NODATA ,插入以下语句,用上一步生成的结果替换 [Calculation]. 包括中括号. setnull([Calculation ] == -9999, [Calculation ]) 点击Evaluate. 13. 在Calculation结果处点击右键选择Make Permanent将最后输出结果保存到硬盘. 旋转地图 编号: 000572 相关产品及版本: ArcInfo Desktop,ArcGIS Engine Developer Kit,ArcGIS Engine Runtime  9.1 平台: PC-Intel Windows 提交时间: 2005-10-09   修改时间: 2005-10-09 提交人: 黄齐飞 内容摘要 旋转当前的地图。 过程描述 使用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 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定义一个投影 编号: 000295 相关产品及版本: ArcInfo Desktop,ArcEditor,ArcView  8.x, 9.0 平台: N/A 提交时间: 2005-03-24   修改时间: 2005-03-24 提交人: 吴乐茂 内容摘要 本文描述如何利用ArcToolBox 给geodatabase或shapefile定义一个自己的投影。 给数据集定义投影是使用ArcGIS的十分重要的一部分。尽管可以利用未定义投影的数据进行工作,但如果未事先定义一个投影,对于具有不同投影的各种数据将无法进行正确叠加。此外,如果数据未定义好投影,某些分析工具将无法得到精确的的分析结果。 定义投影不同于投影数据。定义投影仅是提供ArcGIS为正确显示和处理数据所需要的信息。给数据集定义投影并不改变数据本身的坐标。 注:对于ArcGIS,术语“坐标系统”和“投影”经常可以通用。精确地讲,给数据定义一个坐标系统十分重要。一个坐标系统可以(但不总是)包含投影信息。 过程描述 ArcGIS Engine中Undo、Redo命令的使用 编号: 000325 相关产品及版本: ArcGIS Engine Developer Kit,ArcGIS Engine Runtime  9.0 平台: N/A 提交时间: 2005-03-30   修改时间: 2005-03-30 提交人: 朱政 内容摘要 ArcGIS Engine产品可以对于存储在大型数据库中的地理数据进行编辑,而且对于注册过版本和没有注册过版本的数据都可以进行各种编辑的操作。只是注册过版本的数据需要在一个编辑会话(starteding...stopediting)才能进行编辑。 过程描述 ArcGIS Engine没有提供的各种编辑工具,但是提供了Undo、Redo的命令,但是只有在对注册过版本的表进行编辑时才可以使用这两个命令。 创建带Z值的Feature 编号: 000484 相关产品及版本: ArcInfo Desktop,ArcGIS Engine Developer Kit,ArcGIS Engine Runtime  90 平台: PC-Intel Windows2000 提交时间: 2005-07-01   修改时间: 2005-07-01 提交人: 黄齐飞 内容摘要 使用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 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 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 在Ao中如何通过查询获得ITable 编号: 000631 相关产品及版本: ArcGIS Engine Developer Kit  8.x , 9.x 平台: N/A 提交时间: 2005-12-06   修改时间: 2005-12-06 提交人: 董杰 内容摘要 在Ao调用中可以使用Sql查询获得的ITable 接口的实例 如何实现参数如何设置 过程描述 C# ---------- public static ITable OpenDBQuery(IFeatureWorkspace fw ,string SubFields ,string Tables ,string WhereClause ,string PrimaryKey ,string OutName) { 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=O utName; IName n = qn as IName; ITable t = n.Open() as ITable; return t; } 关于多个实体联合(union)的使用 编号: 000421 相关产品及版本: ArcInfo Desktop,ArcEditor,ArcView,ArcGIS Engine Developer Kit,ArcGIS Server  8.3 9.0 平台: N/A 提交时间: 2005-04-29   修改时间: 2005-04-29 提交人: 谭军辉 内容摘要 实现多个实体的联合,通过这种联合可以与其他几何实体进行空间关系判断,请看如下实例 过程描述 '''''''''''''''''''''''''''''''''''''''''''''''' 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 编号: 000631 相关产品及版本: ArcGIS Engine Developer Kit  8.x , 9.x 平台: N/A 提交时间: 2005-12-06   修改时间: 2005-12-06 提交人: 董杰 内容摘要 在Ao调用中可以使用Sql查询获得的ITable 接口的实例 如何实现参数如何设置 过程描述 C# ---------- public static ITable OpenDBQuery(IFeatureWorkspace fw ,string SubFields ,string Tables ,string WhereClause ,string PrimaryKey ,string OutName) { 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 IWorkspaceNa me; 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接口 编号: 000033 相关产品及版本: ArcInfo Desktop,ArcEditor,ArcView  8.3,9.0 平台: N/A 提交时间: 2004-08-13   修改时间: 2004-08-31 提交人: 朱政 内容摘要 在dll中创建自定义的命令和工具,需要实现ICommand接口,下面就是实现Icommand接口的过程描述。 过程描述 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 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程序按照顶点来分割一条线 编号: 000188 相关产品及版本: ArcInfo Desktop,ArcEditor,ArcView,ArcGIS Engine Developer Kit  8.x 9.0 平台: N/A 提交时间: 2004-12-21   修改时间: 2004-12-21 提交人: 朱政 内容摘要 这篇文章包含了一个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 pPointCollection.AddPoint pSegment.ToPoint Set pOutFeatureBuffer.Shape = pPointCollection pOutFeatureCursor.InsertFeature pOutFeatureBuffer Next i pFeatureCursor.DeleteFeature Set pFeature = pFeatureCursor.NextFeature pOutFeatureCursor.Flu sh 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中选择一个图层来分割它包含的所有的线。 使用AO加载Raster Catalog 编号: 000633 相关产品及版本: ArcGIS Engine Developer Kit,ArcGIS Engine Runtime  8.x , 9.x 平台: N/A 提交时间: 2005-12-06   修改时间: 2005-12-06 提交人: 董杰 内容摘要 建立了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 (); 把不同层的几次的选择结果加到一个选择集中 编号: 000672 相关产品及版本: ArcGIS Engine Developer Kit  9.x 平台: N/A 提交时间: 2005-12-27   修改时间: 2005-12-27 提交人: 朱政 内容摘要 一般情况下,一次选择的结果是一个选择集,当得到下一次的选择结果的时候,前面一次的选择集就自动消失。但有时候选择的操作要分好几次来完成,并且要把这好几次的选择结果进行累加,而且这个过程中可能涉及到不同的层的数据。这种需求下我们可以使用ISelectionEnviroment这个接口来设置选择模式。 过程描述 Dim pSelEnv As ISelectionEnvironment Set pSelEnv = New SelectionEnvironment pSelEnv.CombinationMethod = esriSelectionResultEnum.esriSelectionResultAdd 以上这三句代码您可以放在您要做选择操作之前,这个时候您可以使用IMap的selectFeature,SelectByShape等方法进行选择的操作,操作的结果将会一直进行累加。 最后您可以通过IMap的FeatureSelection来得到选择结果。 如何为ArcObjects扩展出"GroupRenderer"的效果来? 编号: 000669 相关产品及版本: ArcInfo Desktop,ArcEditor,ArcView,ArcGIS Engine Developer Kit,ArcGIS Server  9.0-9.1 平台: N/A 提交时间: 2005-12-26   修改时间: 2005-12-26 提交人: 王嘉彬 内容摘要 图层渲染是GIS应用之中十分常用的功能,所有基于ArcOjects组件的ArcGIS软件产品(如: ArcGIS Desktop, ArcGIS Engine, ArcGIS Server), 还有ArcIMS和MapObjects(Windows Edition & Java Edition)都提供了各种实用的渲染方法,详细列举如下: ArcOjects提供了SimpleRenderer, UniqueValueMapRenderer, ClassBreaksRenderer, DotDensityRenderer, ProportionalSymbolRenderer, ChartRenderer; ArcIMS提供了SimpleRenderer, SimpleLabelRenderer, ValueMapRenderer, ValueMapLableRenderer, ScaleDependentRenderer, GroupRenderer; MapObjects Windows Edition提供了ValueMapRenderer, ClassBreaksRenderer, DotDensityRenderer, LabelRenderer, EventRenderer, ZRenderer, GroupRenderer; MapObjects JavaEdition提供了SimpleRenderer, ValueMapRenderer, LabelRenderer, ScaleDependentRenderer, GroupRenderer; 跟一般的渲染功能有所不同,在ArcIMS和MapObjects的两个版本中都提供的GroupRender它本身并不利用任何图层的属性来对图层进行渲染,而是通过借用其他Renderer的功能,把它们组合起来,实现对同一个图层进行不同类型的渲染效果的同时展现,比如对一个包含了人口总数量,男性人口数量和女性人口数量的世界地图图层(面状)先利用人口总数量属性现实分类渲染的效果,同时利用男性人口数量和女性人口数量属性用直棒图选然展现出两个数值比较的效果。 可惜的是ArcObjects中偏偏没有实现这种渲染功能。不过基于COM技术的ArcObjects所具有的可扩展性为我们自己去实现"GroupRenderer"提供了可能。 过程描述 ArcObjects中,图层的渲染效果是通过实例化一个实现了某个渲染接口(ISimpleRenderer, IUniqueValueMapRenderer, IClassBreaksRenderer, IDotDensityRenderer, IProportionalSymbolRenderer, IChartRenderer之一)的CoClass类,然后作为该渲染接口类型的变量赋给图层(IGeoFeatureLayer)的Renderer属性来实现的。这个Renderer属性是IFeatureRenderer接口类型,IFeatureRenderer中定义了一个叫做Draw的方法,其实ArcObjects中各种各样的渲染效果就是通过这个Draw方法画出来的,因为各个渲染效果CoClass都实现了IFeatureRenderer接口。所以要实现"GroupRenderer"效果,只要实现了IFeatureRenderer接口就可以了。以下提供VB和ArcGIS Server Java API的例程供大家参考: [VB6: CustomGroupRenderer.cls] Option Explicit Implements IFeatureRenderer Private m_Renderers As Collection Private Sub Class_Initialize() On Error GoTo ErrHand Set m_Renderers = New Collection GoTo EndProc ErrHand: MsgBox "Class Initialize" & Err.Description EndProc: Exit Sub End Sub Private Function IFeatureRenderer_CanRender(ByVal featClass As esriGeoDatabase.IFeatureClass, ByVal Display As esriDisplay.IDisplay) As Boolean On Error GoTo ErrHand If Not featClass.ShapeType = esriGeometryNull Then IFeatureRenderer_CanRender = True Else IFeatureRenderer_CanRender = False End If GoTo EndProc ErrHand: MsgBox "CanRender" & Err.Description EndProc: Exit Function End Function Private Sub IFeatureRenderer_Draw(ByVal Cursor As esriGeoDatabase.IFeatureCursor, _ ByVal drawPhase As esriSystem.esriDrawPhase, _ ByVal Display As esriDisplay.IDisplay, _ ByVal trackCancel As esriSystem.ITrackCancel) On Error GoTo ErrHand Dim i As Integer For i = 1 To m_Renderers.Count Dim r As IFeatureRenderer Set r = m_Renderers.Item(i) If (TypeOf r Is ISimpleRenderer) And (drawPhase = esriDPGeography) Then r.Draw Cursor, drawPhase, Display, trackCancel ElseIf (TypeOf r Is IUniqueValueRenderer) And (drawPhase = esriDPGeography) Then r.Draw Cursor, drawPhase, Display, trackCancel ElseIf (TypeOf r Is IClassBreaksRenderer) And (drawPhase = esriDPGeography) Then r.Draw Cursor, drawPhase, Display, trackCancel ElseIf (TypeOf r Is IDotDensityRenderer) And (drawPhase = esriDPGeography) Then r.Draw Cursor, drawPhase, Display, trackCancel ElseIf (TypeOf r Is IProportionalSymbolRenderer) And (drawPhase = esriDPAnnotation) Then r.Draw Cursor, drawPhase, Display, trackCancel ElseIf (TypeOf r Is IChartRenderer) And (drawPhase = esriDPAnnotation) Then r.Draw Cursor, drawPhase, Display, trackCancel End If Next i GoTo EndProc ErrHand: MsgBox "Draw" & Err.Description EndProc: Exit Sub End Sub Private Sub IFeatureRenderer_PrepareFilter(ByVal pFeatClass As esriGeoDatabase.IFeatureClass, ByVal QueryFilter As esriGeoDatabase.IQueryFilter) Dim i As Integer For i = 1 To m_Renderers.Count Dim r As IFeatureRenderer Set r = m_Renderers.Item(i) r.PrepareFilter pFeatClass, QueryFilter Next i End Sub Private Property Set IFeatureRenderer_ExclusionSet(ByVal pIDSet As esriCarto.IFeatureIDSet) End Property Private Property Get IFeatureRenderer_RenderPhase(ByVal drawPhase As esriSystem.esriDrawPhase) As Boolean On Error GoTo ErrHand IFeatureRenderer_RenderPhase = True Exit Property ErrHand: MsgBox "Get RenderPhase" & Err.Description End Property Private Property Get IFeatureRenderer_SymbolByFeature(ByVal Feature As esriGeoDatabase.IFeature) As esriDisplay.ISymbol On Error GoTo ErrHand Dim pSym As ISymbol Set pSym = m_LegendGroup.Class(0).Symbol Set IFeatureRenderer_SymbolByFeature = pSym GoTo EndProc ErrHand: MsgBox Err.Description EndProc: Set pSym = Nothing Exit Property End Property Public Sub AddRenderer(ByVal renderer As esriCarto.IFeatureRenderer) m_Renderers.Add renderer End Sub ========================================================================================================================================================== [ArcGIS Server Java API] //IGroupRenderer.java package com.esri.arcgis.samples.carto.renderers; import com.linar.jintegra.AutomationException; import java.io.IOException; import java.io.Serializable; public interface IGroupRenderer extends Serializable { public static final int IID27AC33C1_506B_41F6_B2F0_D6F163CB7699 = 1; public static final int xxDummy = 0; public static final String IID = "27AC33C1-506B-41F6-B2F0-D6F163CB7699"; public void addRenderer(Object iRenderer) throws IOException, AutomationException; } //CustomGroupRenderer.java package com.esri.arcgis.samples.carto.renderers; import java.io.IOException; import java.util.ArrayList; import com.esri.arcgis.server.*; import com.esri.arcgis.carto.*; import com.esri.arcgis.display.*; import com.esri.arcgis.geodatabase.*; import com.esri.arcgis.system.*; import com.esri.arcgis.geometry.esriGeometryType; import com.esri.arcgis.system.esriDrawPhase; import com.linar.jintegra.AutomationException; public class CustomGroupRenderer implements IFeatureRenderer, IGroupRenderer { private ILegendGroup pLegendGroup; private IServerContext serverContext; private ArrayList renderers = new ArrayList(); public CustomGroupRenderer(IServerContext sc) { try { serverContext = sc; pLegendGroup = new ILegendGroupProxy(serverContext.createObject(LegendGroup.getClsid())); ILegendClass pLegendClass = new ILegendClassProxy(sc.createObject(LegendClass.getClsid())); pLegendGroup.addClass(pLegendClass); pLegendGroup.setVisible(true); pLegendGroup.setEditable(true); } catch (AutomationException e) { System.out.println("AutomationException " + e); } catch (IOException e) { System.out.println("IOException " + e); } } public boolean canRender(IFeatureClass iFeatureClass, IDisplay iDisplay) throws IOException, AutomationException { if (iFeatureClass.getShapeType() == esriGeometryType.esriGeometryNull) { return true; } else { return false; } } public void prepareFilter(IFeatureClass iFeatureClass, IQueryFilter iQueryFilter) throws IOException, AutomationException { if (renderers.size() > 0) { for (int i = 0; i < renderers.size(); i++) { IFeatureRenderer pFR = new IFeatureRendererProxy(renderers.get(i)); pFR.prepareFilter(iFeatureClass, iQueryFilter); } } } public void draw(IFeatureCursor iFeatureCursor, int drawPhase, IDisplay iDisplay, ITrackCancel iTrackCancel) throws IOException, AutomationException { if (renderers.size() > 0) { for (int i = 0; i < renderers.size(); i++) { Object obj = renderers.get(i); if (obj instanceof ISimpleRenderer && drawPhase == esriDrawPhase.esriDPGeography) { IFeatureRenderer pFR = new IFeatureRendererProxy(obj); pFR.draw(iFeatureCursor, drawPhase, iDisplay, iTrackCancel); } if (obj instanceof IUniqueValueRenderer && drawPhase == esriDrawPhase.esriDPGeography) { IFeatureRenderer pFR = new IFeatureRendererProxy(obj); pFR.draw(iFeatureCursor, drawPhase, iDisplay, iTrackCancel); } if (obj instanceof IClassBreaksRenderer && drawPhase == esriDrawPhase.esriDPGeography) { IFeatureRenderer pFR = new IFeatureRendererProxy(obj); pFR.draw(iFeatureCursor, drawPhase, iDisplay, iTrackCancel); } if (obj instanceof IDotDensityRenderer && drawPhase == esriDrawPhase.esriDPGeography) { IFeatureRenderer pFR = new IFeatureRendererProxy(obj); pFR.draw(iFeatureCursor, drawPhase, iDisplay, iTrackCancel); } if (obj instanceof IProportionalSymbolRenderer && drawPhase == esriDrawPhase.esriDPAnnotation) { IFeatureRenderer pFR = new IFeatureRendererProxy(obj); pFR.draw(iFeatureCursor, drawPhase, iDisplay, iTrackCancel); } if (obj instanceof IChartRenderer && drawPhase == esriDrawPhase.esriDPAnnotation) { IFeatureRenderer pFR = new IFeatureRendererProxy(obj); pFR.draw(iFeatureCursor, drawPhase, iDisplay, iTrackCancel); } } } } public ISymbol getSymbolByFeature(IFeature iFeature) throws IOException, AutomationException { ISymbol pSym = pLegendGroup.esri_getClass(0).getSymbol(); return pSym; } public boolean isRenderPhase(int drawPhase) throws IOException, AutomationException { return true; } public void setExclusionSetByRef(IFeatureIDSet iFeatureIDSet) throws IOException, AutomationExce ption { } public void addRenderer(Object iRenderer) throws IOException, AutomationException { renderers.add(iRenderer); } } 如果想要在TOC控件上动态的展现出渲染的效果,还需实现ILegendInfo接口,这里不做详细说明。 在AO或者ENGINE中为SHAPEFILE添加SPATIAL INDEX 编号: 000390 相关产品及版本: ArcInfo Desktop,ArcGIS Engine Developer Kit  8.3,9.0,9.1 平台: N/A 提交时间: 2005-04-21   修改时间: 2005-04-21 提交人: 许春杰 内容摘要 在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 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环境中的查询功能 编号: 000759 相关产品及版本: ArcInfo Desktop,ArcEditor,ArcView,ArcGIS Extension  9.0、9.1 平台: Win+VB 提交时间: 2006-05-12   修改时间: 2006-05-12 提交人: 谭军辉 内容摘要 在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   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     '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 截取任意范围地图区域 编号: 000596 相关产品及版本: ArcInfo Desktop,ArcEditor,ArcView,ArcGIS Engine Developer Kit  9.0,9.1 平台: PC-Intel Windows 提交时间: 2005-11-01   修改时间: 2005-11-01 提交人: 文定梦 内容摘要 通过区域范围选择所需要的地物,在大多数情况下是基于矩形范围进行的,可以使用下面的代码进行任意范围(如多边形、圆等)的地物选取,并以当前选择范围对地物进行裁剪 过程描述 '截取任意面积地图区域 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 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 pOu tFeat 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 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 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种方法 编号: 000634 相关产品及版本: ArcGIS Engine Developer Kit  8.x , 9.x 平台: N/A 提交时间: 2005-12-06   修改时间: 2005-12-06 提交人: 董杰 内容摘要 在向Table、FeatureClass 中添加记录的时候有几种可供选用的插入方法 他们在不同的使用环境中效率不同…… 过程描述 ------------- 1 Store 方法 使用IRow、IFeature 的Store 由ITable 或 IFeatureClass 的 CreateRow() CreateFeature() 方法先创建对象经赋值操作后调用 Store 此方法在各种环境中速度均较低 但其获得的信息相对最全 适用于经UI交互产生的数据对象 a)在CreateRow() 时进行一次数据库访问 [insert] b)创建之后已Row中已返回 OID 值 c)其他字段赋值之后调用Store 进行第二次数据库访问 [updata] 此时激发 Row对象的 onChange等事件调用 -------------- 2 WriteRow方法 使用ITableWrite.WriteRow() 或 IFeatureClassWrite.WriteFeature() 由ITable 或 IFeatureClass 的 CreateRow() CreateFeature() 方法先创建对象 经赋值操作后调用 ITable.WriteRow() 或 IFeatureClass.WriteFeature() 此方法调用ITableWrite这类较底层的接口 区别在于在写入数据时不会激发相应事件 在对象不影响网络拓扑结构的前提下写入几何网络图层数据速度较快 a)在CreateRow() 时进行一次数据库访问 [insert] b)创建之后已Row中已返回 OID 值 c)其他字段赋值之后调用Store 进行第二次数据库访问 [updata] 此时不激发事件 ----------------- 3 Insert Buffer 使用ITable.CreateRowBuffer() 或 IFeatureClass.CreateFeatureBuffer()创建内存对象 由IFeatureCursor.InsertFeature()写入只访问一次数据库速度较快 但是内存对象在写入前 OID=-1 适用于批量写入简单要素 a)在CreateRowBuffer() 创建内存对象 b)创建之后已Row中OID = -1 c)其他字段赋值之后调用ICursor.Insert() 进行一次数据库插入 此时不会相应事件  如何在ArcEngine环境中的SceneControl中实现查询功能 编号: 000758 相关产品及版本: ArcGIS Extension,ArcGIS Engine Developer Kit  9.0、9.1 平台: Win、VB 提交时间: 2006-05-12   修改时间: 2006-05-12 提交人: 谭军辉 内容摘要 如何实现3D环境中的3D查询功能 过程描述 Public Type m_pObjArray       iFeature As iFeature       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         '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;     //取一个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     } 创建孤立的要素类和数据集中的要素类 编号: 000210 相关产品及版本: ArcInfo Desktop,ArcEditor,ArcView,ArcGIS Engine Developer Kit  8.3 9.0 平台: N/A 提交时间: 2005-01-21   修改时间: 2005-01-21 提交人: 朱政 内容摘要 下面列出的是创建孤立要素类的代码,是使用IFeatureWorkspace中的CreateFeatureClass方法。创建要素集中的要素类使用的是IFeatureDataset中的createfeatureclass中的方法。创建孤立的要素类指的是在某个工作空间中创建shapefile或者是创建不属于任何数据集中的要素类,创建这类要素类的时候一定要指明spatial reference,即使是没有坐标系的也要指定为UnknownCoordinateSystem。否则创建完毕之后就会出错。而在创建数据集中的要素类就可以不用指定spatial reference,如果指定的话需要和数据集中的spatial reference相匹配。 过程描述 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 .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 pFieldsEd it.AddField pField '创建要素类 Set pOutFeatureClass = pFeatureWorkspace.CreateFeatureClass("MyShape33", pFields, Nothing, Nothing, esriFTSimple, "shape", "") SUM Color of vertex symbols in edit Jul 23 2003 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. 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 '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 83318 208 678 -0461 ex 16 gyoung@pn.usbr.gov 要素动态跟踪的算法 这个算法其实很简单,核心原理是在一个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 这个函数可取出符合要求的点集出来。 //闪烁目标         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.GeometryT ype)                 {                     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)         {             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;             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:     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             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                                     Do Events                                 Next                             End If         End Select             .FinishDrawing     End With     Exit Sub EH:     MsgBox "闪烁过程中出现错误:" & Err.Description, vbExclamation, "系统错误提示" End Sub 旋转地图 2006-06-07 19:37:05 大中小 编号: 000572 相关产品及版本: ArcInfo Desktop,ArcGIS Engine Developer Kit,ArcGIS Engine Runtime 9.1 平台: PC-Intel Windows 提交时间: 2005-10-09 修改时间: 2005-10-09 提交人: 黄齐飞 内容摘要 转载于http://support.esrichina-bj.cn/esrilink/techarticle.php?file=000572 旋转当前的地图。 过程描述 使用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 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  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 14  15  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 22  23  ' Error checking 24  If pInputTable Is Nothing Then 25    MsgBox "Table QI failed" 26    Exit Sub 27  End If 28  29  If pOverlayTable Is Nothing Then 30    MsgBox "Table QI failed" 31    Exit Sub 32  End If 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 43  44  ' 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" 49  50  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 56  57  Dim tol As Double 58  tol = 0#      ' Perform the intersect 59  Dim pBGP As IBasicGeoprocessor 60  Set pBGP = New BasicGeoprocessor 61  62  Dim pOutputFeatClass As IFeatureClass 63  Set pOutputFeatClass = pBGP.Intersect(pInputTable, False, pOverlayTable, False, _ 64    tol, pFeatClassName) 65    66  ' 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 73 74 75 二、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; 10 11                //叠加表 12                pLayer=this.axMapControl1.get_Layer(1); 13                ITable pOverlayTable=pLayer as ITable; 14 15                //叠加分析表 16                IFeatureClassName pFeatClassName=new FeatureClassNameClass(); 17                pFeatClassName.FeatureType=esriFeatureType.esriFTSimple; 18                pFeatClassName.ShapeFieldName="shape"; 19                pFeatClassName.ShapeType=pInputFeatClass.ShapeType; 20 21                //工作空间名称 22                IWorkspaceName pNewWSName=new WorkspaceNameClass(); 23                pNewWSName.Wo rkspaceFactoryProgID = "esriDataSourcesFile.ShapefileWorkspaceFactory"; 24                pNewWSName.PathName = @"C:\temp"; 25 26                //数据集名称 27       转载-AO代码〔Display) 2006-06-06 19:37:15 大中小 发信人: zdq (我就是哈哈(HaHa)), 信区: DigitalEarth 标 题: 转载-AO代码〔Display) 发信站: 水木社区 (Tue Jun 6 12:29:05 2006), 站内 显示设计模式 为了帮助你理解怎样和各种显示对象一起工作来解决一般的开发需求,一些应用情节和细节在他们执行被给。用这些模式作为显示对象一起工作的引点。 应用窗口 最一般的任务之一是来在支持滚动和备份存储的应用窗口的客户端区域绘制地图。这个显示对象在下面的情况可能被用。 初始化 当窗口被创建时,通过创建一个Screen Display开始。你需要创建一个或多个符号用来绘制形状。使应用句柄到pScreenDisplay.Hwnd。从它IDisplayTransformation接口的Screen Display得到和用pTransformation.Bounds和pDisplayTransform.VisibleBounds来设置全图和可视范围。可视范围决定当前空间水平。Screen Display关心更新DeviceFrame的转化显示。Screen Display管理窗口的消息和一般的事件的句柄像窗口的大小和滚动。 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 这段程序可以在任何设备中绘制多边形。不管怎么样,第一地方我们需要绘制到窗口。为了处理这个,在那些应用程序的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() 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(); } 画线 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(); 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中标注字段属性数据 2006-05-13 18: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(); IfeatureSelection:SelectFeatures方法介绍 2006-05-11 21: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"))) 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)┆打印 文章评论 以下网友留言只代表其个人观点,不代表新浪网的观点或立场 笨耗子 2006-05-11 21: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()); } 测试时两个MessageBox都显示正常,但地图没有任何变化,说明前面两句:闪烁和图幅变化都没有执行,运行并无抱错,我实在是不知怎么找到错误了,望你能指点一下检查途径,谢谢你! 笨耗子 2006-05-11 21: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就可以。 AO基本函数集合(很多函数功能) 2006-05-11 09: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 Dim pId As New UID Set pMxDoc = g_spApp.document. Set pMap = pMxDoc.FocusMap pId.value = "{EDAD6644-1810-11D1-86AE-0000F8751720}" 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 ' 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 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 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 Dim player As ILayer Dim pId As New UID Set pMxDoc = g_spApp.document. Set pMap = pMxDoc.FocusMap '对GroupLayer图层进行操作 '设置GroupLayer图层为可见 pId.value = "{EDAD6644-1810-11D1-86AE-0000F8751720}" 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 Set pMxDoc = g_spApp.document. Set pMap = pMxDoc.FocusMap '对GroupLayer图层进行操作 '设置GroupLayer图层为可见 pId.value = "{EDAD6644-1810-11D1-86AE-0000F8751720}" 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 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画一个多边形 2006-05-10 15: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 ESRI.ArcGIS.Geometry.Envelope box.PutCoords(X, Y , X + 2000, Y + 2000) m_mapctrl.DrawShape(box, pfillSymbol) End If 调用AfterDraw : mapctrol.refresh 或者 Me.m_mapctrl.ActiveView.PartialRefresh(ESRI.ArcGIS.Carto.esriViewDrawPhase.esriViewForeground, Nothing, Nothing) System.Windows.Forms.Application.DoEvents() '强制mapcontrol即时刷新 AO画带节点的线 2006-05-10 15: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 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的面积 2006-05-10 15: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)) Next AO缓冲区查询 2006-05-10 15: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) 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画一个圆 2006-05-10 15: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 * 3.1415926) 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 () 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 < 3.1415926 * 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 调用AfterDraw : mapctrol.refresh 或者 Me.m_mapctrl.ActiveView.PartialRefresh(ESRI.ArcGIS.Carto.esriViewDrawPhase.esriViewForeground, Nothing, Nothing) System.Windows.Forms.Application.DoEvents() '强制maocontrol即时刷新 AO查询被选中的实体 2006-05-10 15: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 '可以是任何geometry Private mrdsSelectedFeatures As IFeatureCursor '空间查询结果,通过该变量来遍历记录 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, 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绘制带节点橡皮筋线条 2006-05-10 15:02:52 大中小 线及橡皮筋均为红色,最后节点为绿色,其余为蓝色,双击后最后一个节点也变成蓝色 '**----------------------------------------** '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 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.esriViewForeground, 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.esriViewForeground, 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.esriViewForeground, Nothing, Nothing) 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.esriViewForeground, 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 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 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 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.esriViewForeground, Nothing, Nothing) System.Windows.Forms.Application.DoEvents() '强制maocontrol即时刷新 Catch ex As Exception MsgBox("画笔清空错误:" & ex.Message, MsgBoxStyle.Critical, "错误提示") End Try End Sub AO绘制橡皮筋多边形 2006-05-10 15: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 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) ' 需要加两次,最后一个点会在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 AO绘制缓冲区 2006-05-10 15: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 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鹰眼图代码 2006-05-10 08: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 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 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文件的某个属性的属性值 2006-04-24 21: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) 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客户端控件的开发 2006-04-21 10:14:59 转载 开发GIS与OA一体化系统时,OA中经常需要使用图形的浏览、查询等功能,这在OA系统采用C/S模式的情况下,并不困难,但在采用B/S架构时,却往往不知从何下手。一般的做法时采用ArcIMS等软件作为服务器端软件进行开发,但这些软件需要额外购买,很不划算。其实我们将MO作为一个ActiveX控件插入到网页中,用javascript进行控制,也可以实现非常强大的功能。 下面举一个例子,可以实现加载图层,放大,缩小和平移功能。 New Page 1

  MO作为B/S服务器端的开发 2006-04-21 10: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 = "127.0.0.1" .RemotePort = 4001 .Bind 4002 End With 并在Form_Load中进行地图的初始化:加载图层,以及符号化等。 然后在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文件。总之这种文件能够定义地图的图层及显示效果等,你的程序必须能够加载种文件。 主要就是这几条吧。我也没有偿试去做,因为我现在不需要用它了~呵呵。 两点间画线 2006-04-24 21: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 .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 2006-04-25 18: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 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 2006-04-18 16:31:09 大中小 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中的一些概念:   1)             Class(类):AO中有三种类。abstract calss(抽象类):抽象类算一个超类,不能用来实例化一个对象,比如 Line就是一个抽象类,其他的线是Line之上,Line给出了所有线性的共同特性和方法;CoClass:这种类可以直接通过new方法实例化出一个对象;Class:这种类不能直接new出一个对象,但是可以通过实例的属性得到或者通过某个方法生成一个对象。 2)             Interface(接口):接口跟类的概念,一个类可以提供很多个接口。 3)             Relationships Between Classes:类之间的关系有Association(关联),Type Inheritance(继承),instantiation(实例化),Composition(组成)。 a)        Association表示一个类的实例可以和几个其他类的实例相关联,比如一个Line Symbol对象只能和一个线对象相关。 b)        Type Inheritance是一个类可以通过继承,得到其父类的属性和方法,比如Line这个超类之上可以有其他类型的特定线类。 c)        Instantiation是某个类的某个方法可以实例化其他类的实例,比如IWorkspaceFactory类的OpenFromFile()方法可以实例化一个IFeatureWorkspace类的实例。 d)        Composition是一个强制的关系,是一个类的实例包含了其他的类的实例,比如一个points会包含很多个point,当这很多的point的生命周期没有结束,points对象就不能从内存中卸载掉。 清楚了类的类型和类之间的关系,对于合理的应用类,正确的实例化和卸载类,提高开发的可靠性,清楚类的运行机制很有帮助。 ArcObject学习的重要工具--Object Model Diagrams (二) 2006-04-18 16:34:47 大中小 示例:   现在通过一个实例给出如何利用Object Model Diagram,ArcObjects Developer help和EOBrowser来寻找完成某一个操作所需要设计的类和方法。实例如下:访问 C:\data\US.mdb这个GeoDatabase中的“Status”这个Feature Class。 首先,知道这个操作与GeoDatabase有关,可以打开GeoDatabase这个Object Model Diagram,利用pdf的查找功能查找Access这个关键字(Access是访问数据库的关键字,如果Diagram不大,可以浏览整个Diagram寻找),可以发现一个AccessWorkspaceFactory类。但是在Developer Help中可以看到AccessWorkspaceFactory类提供了三个接口IWorkspaceFactory,IWorkspaceFactory2,ILocalDatasetCompact。其中接口IWorkspaceFactory有一个OpenFromFile()方法可以打开一个database,可以定义一个IWorkspaceFactory接口来应用这个方法,但是需要实例化一个类来实现这个方法,但WorkspaceFactory是一个抽象类,但AccessWorkspaceFactory类继承了WorkspaceFactory,所以可以用AccessWorkspaceFactory类来实现IWorkspaceFactory接口使用OpenFromFile()方法。 然后,OpenFromFile()方法返回了一个IWorkspace接口,在Workspace类中有一个IFeatureWorkspace接口,可以通过这个把OpenFromFile()方法返回到一个IFeatureWorkspace上,IFeatureWorkspace类有一个OpenFeatureClass()方法。所以可以用这样的代码来实现上面的示例: Dim pWSF as IWorkspaceFactory Dim pWS as IWorkspace Dim pFWS as IFeatureWorkspace Dim pFC as IFeatureClass Set pWSF = New AccessWorkspaceFactory Set pWS = pWSF.OpenFromFile(“C:\data\US.mdb”,0) Set pFWS=pWS ‘QueryInterface Set pFC=pFWS.OpenFeatureClass(“States”) 利用Object Model Diagrams可以清楚的了解类的关系,一个类到底有什么接口,接口之间是什么关系,用某一个方法会返回什么样的类型的结果,如果利用这些结果,如果能够很好的利用这些类图的话,对于 ArcObjects会有一个更深的理解! AO开发感想 2006-04-14 13:33:31 大中小 用AO开发已经有一段时间了,对AO开发的模式也有一定的了解了!AO是ESRI开发的一组COM的集合,利用它用户可以进行二次开发,以快速建立满足自己要求的GIS应用. AO开发就是利用一些类和这些类的接口进行开发. 1、抽象类,类,和组件对象类 抽象类是不能实例化的,抽象类中是一系列抽象的方法,故是不能实例化的,它只能被继承。不同的类可以继承同一个抽象类,但内部对同一方法的实现可能是不一样的。如AO中的接口都是抽象类。用户可以在类中实现这些接口,也就是继承这些接口。如用户可以在自己的类中实现ICommand接口,生成一个Command,或者实现ICommand、ITool接口,生成一个Tool. 类是不能直接实例化的,它只能作为另一个类的属性或者被其它类的对象实例化。如Sde3Workspace Class、Sde4Workspace Class,FeatureClass,FeatureDataset它们是不能通过New直接实例化的,只能通过SdeWorkspaceFactory CoClass这个组件对象类所实现的IWorkspaceFactory接口里的Open方法来实例化。FeatureClass,FeatureDataset也是不能直接实例化的,他只能通过IFeatureWorkspace接口里的CreateFeatureClass,CreateFeatureDataset方法来实例化。 组件对象类能够通过New来直接实例化。如 SdeWorkspaceFactory,QueryFilter它们是可以通过New来直接实例化的。 2、继承 3、类和接口的实现 一些类可能实现多个接口,一个接口也可能被多个类所实现,但不同的类实现同一个接口可能内部并不是一样的,这就实现了多态性.如ILayer这个接口被多个接口实现,其中包括FeatureLayer和RasterLayer,但这两个类实现ILayer接口时内部实现肯定是不一样的!但在外部对ILayer的操作是一样的! 4、接口之间的相互查询 一个类可以实现多个接口,每一个接口可能包括一系列的属性和方法,但有时候一个接口里可能没有你想要的方法和属性,可能在这个类所实现接口的另一个接口里,这就涉及到从一个接口转到这个类所实现接口的另一个接口里,对于类所实现的一系列接口里,接口间是可以相互跳转的。如我想对一个feature的属性进行修改,给的就是这个feature的IFeature接口,我们知道对一个feature进行修改必须要把这个feature所在的featureclass的工作空间设为可编辑,且编辑结束后要结束编辑,这就要通过这个IFeatue接口来获得这个这个feature所在的IFeatureClass接口和IWorkspace接口,我们知道IFeatue接口里有一个object属性,这个属性返回的是IObjectClass,而FeatureClass这个类实现了IObjectClass和IFeatureClass这两个接口,这样就可以通过接口跳转从IObjectClass转换成IFeatureClass,这样就可以获得feature的IFeatureClass接口,其代码(c#)如下: IObjectClass i_objcls=I_FtrCur.Class; IFeatureClass i_ftrcls=(IFeatureClass)i_objcls; Feature所在的FeatureClass的IFeatureClass接口有了,还要这个FeatureClass所在的工作空间的IWorkspace接口,获取这个接口可以通过两个方法 一、通过IFeatureClass接口里的FeatureDataset属性来获得IFeatureDataset接口。IFeatureDataset接口里有一个Workspace属性返回IWorkspace接口,但这种方法有一个特别说明就是这个FeatureClass必须是一个FeatureDataset的成员,如果这个FeatureClass是一个独立,这个FeatureDataset返回的就是一个空值。所以这种方法对FeatureClass是一个FeatureDataset的成员时是适用的,独立时就不适用了。 二、通过接口转换。 FeatureClass实现了多个接口,其中有IDataset接口和IFeatureClass接口,我们已经有了IFeatureClass接口,就可以通过接口跳转来获得IDataset接口,在IDataset接口里有一个Workspace属性返回IWorkspace接口,这种方法对于FeatureClass是一个FeatureDataset的成员和FeatureClass是独立的这两种情况都是可以的。代码如下: IDataset i_ftrDset=(IDataset)i_ftrcls //接口跳转 IFeatureWorkspace i_wks=(IFeatureWorkspace)i_ftrDset.Workspace AO中的组件库(1) 2006-04-14 13:35:32 大中小 转载http://www.hmgis.cn AO中的组件库(1) 在ArcObjects中数目巨大的COM对象,很多的功能都是相似或者接近的,为了更好地管理这些COM对象,ESRI将它们放置在不同的组件库中,从.NET的角度看,它们是被组织到同一个命名空间中。 使用VB.NET或者C#的读者都会很清楚“命名空间”(NameSpace)的概念,命名空间以一种分层的方式来组织元素的方法。我们知道,对于AO中众多的COM对象,当我们需要使用它们的时候,必须记住每个的名字,这是非常困难的。某些高级程序语言提供了一种逻辑上的聚合方式,以实现更高层次的组件管理。 再用我们在第二节中讨论接口时使用的“公司例子”,如果一个城市拥有上千家公司,这些公司有的业务是相同的,有些则有很大的差别,一家合法的公司都必须在工商局进行备案,那么工商局该如何管理这些数目众多的公司呢?是无区分地任意保存它们的资料,还是分门别类地按照业务范围进行划分?答案显然是后者,工商局可以依据这些公司的业务类别,如IT企业、医药企业、酒店业等进行分别的登记造册。 命名空间也是这样,它将功能相同或者相似的COM对象松散组织起来,在AO Desktop版本中,我们将众多的组件放在不同命名空间。如果我们要进行地理数据操作,需要引入Geodatabase等相关的命名空间,如果涉及到几何形体对象的处理,就需要引入Geometry等命名空间。这种方法让我们在寻找具体的COM对象时更有目标性,它是一种比Class更高层次上的抽象概念。 ArcGIS Desktop版本的AO核心对象被放在53个组件库中,不同的组件库的聚合的功能是不一样的。作为一个程序员。其实没有必要去看每一个组件库,阅读所有的AO组件库是一件不可能的事情。我们应该首先了解一些最基本的组件库后,在将来的实际开发中继续学习自己需要掌握的组件库。 在这些命名空间中,有一些是我们经常使用到的,如Carto、Geometry、system、systemUI、FrameWork等等,需要我们熟练掌握。当我们不记得某个接口或对象属于哪个命名空间的时候,我们可以通过开发帮助很容易地查找到。 学习AO的过程,也就是不断了解这些组件库本身以及库与库之间关系的过程,本节我们将介绍一些最核心的组件库,以给读者了解AO的大概提供帮助。 l System库 System库是ArcGIS框架中最底层的一个库,它提供了一些可以为其它库使用的组件,这些组件都是非常基本的。如数组(Array)、集合(Sets)、Xml对象、Stream对象、分级(Classify)对象和数字格式(NumberFormat)对象等。 数组和集合都是基本的数据单元,而XML对象则给AO提供了操作XML类型文件的能力;Stream对象可以将数据以流的形式保存为如何格式的文件。 分级对象和数字格式对象都和数值数据有关,前者是使用统计函数将数值数据进行不同类型的分级,这个对象大多使用在分级作色中。后者可以让输出的数值的格式互相转变,如角度转弧度,设置小数点等等。 l SystemUI库 SystemUI库定义了一些被ArcGIS用户界面组件所使用的对象,如ICommand、ITool等。在第二章中我们将专门介绍这些程序界面定制的内容。 l Geometry库 Geometry库包含了核心的几何形体对象,如点、线、面等,即在AO中的要素和图形元素的几何形体都可以在这个组件库中寻找到。除此以外,这个库还包含了空间参考对象,包括GeographicCoordinateSystem(几何坐标系统)、ProjectedCoordinateSystem(投影坐标系统)和GeoTransformations(地理变换)对象等。 几何形体对象和空间参考内容,都是AO中比较重要的部分,本书将有专门的章节讲述。 l Display库 Display库包含在输出设备上显示图形所需要的组件对象,它包括Display对象、Color对象、ColorRamp对象、Display Feedbacks对象、Rubber Bands对象、Trackers对象和Symbol对象。 这个库中的对象主要负责GIS数据的显示,如Color和ColorRamp对象可以产生颜色对象,它配合Symbol对象,可以对地理数据进行符号化操作,以产生丰富多彩的地图图形。 Display对象是地图显示的“幕后推手”,它直接管理了地理数据的绘制和显示,DisplayFeedback则是AO中可以使用鼠标与地理视图进行交互的对象,它的内容非常丰富,可以用于绘制图形或移动图形等高级任务。RubberBands对象则相当于一个“橡皮筋对象”,它可以用于在Display上绘制丰富的几何形体对象,如Circle、Rectangle、Polyline和Polygon等。 l DisplayUI库 DisplayUI库提供了具有可视化界面的对象用于辅助图形显示,它包括Property Pages(属性页)对象和StyleGalleryClass对象,前者可以用于设置Symbol对象,而后者则可以用于管理和获取Style(样式)和Symbol(符号)对象。 关于这两个对象,我们将在后面的章节中详细讨论。 l Controls库 Controls库包含了在程序开发中可以使用的可视化组件对象,如MapControl、PageLayoutControl等,这两个对象是本书的研究重点。在本书将辟出专门的章节来讨论这两个对象。 l ArcMapUI库 ArcMapUI库中的对象为ArcMap程序提供了某些可视化的用户界面,这些对象不能在ArcMap结构之外使用,它必须在ArcMap的框架内。IMxApplication和IMxDocument接口都被定义在这个库中,但是它们的实现都在ArcMap库中。 ArcMap的TOC对象也是在这个库中被实现的,TOC即是Table Of Contents,即内容表对象。程序员可以扩展这个库的内容,为ArcMap程序产生自定义的命令或工具。

下载文档到电脑,查找使用更方便

文档的实际排版效果,会与网站的显示效果略有不同!!

需要 15 金币 [ 分享文档获得金币 ] 5 人已下载

下载文档