2024年2月21日发(作者：)
目 录
基础篇 ............................................................ 5
1.1. 开发环境 ...................................................................................... 5
1.1.1. 如何在ArcMap的VBA环境中编程 ................................................ 5
1.1.2. 如何在VB环境中利用ArcObjects组件开发ActiveX DLL ......... 10
1.1.3. 如何在ArcMap中加载利用ArcObjects组件开发的ActiveX DLL 12
1.1.4. 如何在VB环境中利用ArcObjects控件开发EXE ....................... 13
1.2. 用户界面 .................................................................................... 15
1.2.1. 如何创建定制的按钮(Button) .................................................... 15
1.2.2. 如何创建定制的Tool ................................................................. 17
1.2.3. 如何创建定制的工具条(Tool Bar) ............................................ 19
1.2.4. 如何创建定制的MultiItem ........................................................ 21
1.2.5. 如何创建定制的菜单(Menu) ....................................................... 23
1.2.6. 如何创建定制的ToolControl ..................................................... 24
1.2.7. 如何创建定、使用制的可停靠窗口(Dockable Window) ............. 27
1.2.8. 如何创建、使用定制的Extension ............................................. 29
1.2.9. 如何使用状态条(StatusBar)与进度条(ProgressBar) ............... 30
1.2.10. 如何使用ArcGIS的对话框 ......................................................... 32
1.2.11. 如何调用ArcMap中现有的功能 .................................................. 32
1.2.12. 如何创建放大镜(虫眼) ............................................................... 33
1.3. GeoDataBase ............................................................................ 34
1.3.1. 如何加载Shape文件 .................................................................. 34
1.3.2. 如何在ArcMap中加入Text和dBASE文件 ................................. 35
1.3.3. 如何连接GeoDataBase文件 ....................................................... 37
1.3.4. 如何连接Coverage文件 ............................................................. 39
1.3.5. 如何连接栅格文件 ...................................................................... 41
1.3.6. 如何创建Shape文件 .................................................................. 42
-1-
1.3.7. 如何创建DBF文件 ...................................................................... 45
1.3.8. 如何创建GeoDataBase文件 ....................................................... 47
1.3.9. 如何创建Coverage文件 ............................................................. 48
1.3.10. 如何建立文件连接(Join / Link) .............................................. 50
1.3.11. 如何浏览纪录(属性查询) ........................................................... 52
1.3.12. 如何编辑记录 ............................................................................. 53
1.3.13. 如何增加记录 ............................................................................. 54
1.3.14. 如何删除记录 ............................................................................. 56
1.3.15. 如何纪录排序(ITableSort) ....................................................... 58
1.3.16. 如何添加字段 ............................................................................. 59
1.3.17. 如何删除字段 ............................................................................. 61
1.3.18. 如何进行空间查询 ...................................................................... 62
1.3.19. 如何进行高级空间查询(两个层之间的空间查询) ....................... 64
1.3.20. 如何进行层与层之间的逻辑运算 ................................................ 65
1.3.21. 如何将shape文件转化成GeoDataBase(各种文件格式的转换) .. 67
1.3.22. 如何将Map中显示的图形转化成栅格文件 ................................. 70
1.3.23. 如何打开选中的层或独立表的属性窗口 ..................................... 71
1.3.24. 如何拷贝属性表中的一行 ........................................................... 73
1.3.25. 如何为当前层或独立表创建一个Summary表 .............................. 75
1.3.26. 如何利用用户定义的规则创建定制的排序 ................................. 78
1.3.27. 如何实现在ArcMap上进行属性查询(Identify) ........................ 84
1.3.28. 如何设置和修改层的数据源 ....................................................... 87
1.4. Display ...................................................................................... 88
1.4.1. 如何实现在ArcMap中放大缩小地图 ........................................... 88
1.4.2. 如何实现在ArcMap中移动地图 .................................................. 90
1.4.3. 如何实现在ArcMap上画Polygon ............................................... 92
1.4.4. 如何实现在ArcMap上进行测量 .................................................. 94
1.4.5. 如何实现在ArcMap上选取中记录 ............................................ 100
1.4.6. 如何实现在ArcMap中进行动作的撤销和重做 .......................... 101
1.4.7. 如何画Polygon Buffers .......................................................... 102
-2-
1.5. 图元编辑 .................................................................................. 104
1.5.1. 如何得到图形的基本属性 ......................................................... 104
1.5.2. 如何将选中的点集转换成Polygon ........................................... 105
1.5.3. 如何将Multipoint转换成Points ........................................... 109
1.5.4. 如何通过Polygon中的多个Ring创建多个Polygon ................ 111
1.5.5. 如何从Polyline创建Polygon ................................................. 113
1.5.6. 如何从Polygon创建Polyline ................................................. 115
1.5.7. 如何将Polygon/PolyCurve一般化(Generalize) ..................... 117
1.5.8. 如何获得Polygon的中点 ......................................................... 119
1.5.9. 如何判断图形间的逻辑运算 ..................................................... 121
1.5.10. 如何进行图形间的逻辑运算 ..................................................... 124
1.5.11. 如何创建Envelope的Boundary ............................................... 127
1.5.12. 如何通过鼠标移动图形 ............................................................. 130
1.5.13. 如何为一个图形添加一个顶点 .................................................. 133
1.5.14. 如何删除一个图形上的一个顶点 .............................................. 136
1.5.15. 如何移动一个图形上的一个顶点 .............................................. 138
1.6. Element ................................................................................... 141
1.6.1. 如何创建MarkerElement .......................................................... 141
1.6.2. 如何创建TextElement .............................................................. 142
1.6.3. 如何创建Balloon Callout ...................................................... 144
1.6.4. 如何创建PolygonElement ........................................................ 145
1.6.5. 如何选中一个Element .............................................................. 146
1.6.6. 如何移动Element ..................................................................... 147
1.6.7. 如何排列Element ..................................................................... 151
1.6.8. 如何通过名字查询Element ...................................................... 153
1.6.9. 如何拷贝Element ..................................................................... 155
1.6.10. 如何沿着折线路径显示Text .................................................... 158
1.7. Symbol和Renderer ............................................................... 159
1.7.1. 如何为一个层设置Simple Renderer ........................................ 159
1.7.2. 如何为一个层设置UniqueValue Renderer ............................... 161
-3-
1.7.3. 如何为一个层设置ClassBreaks Renderer ............................... 165
1.7.4. 如何为一个层设置ProportionalSymbol Renderer .................. 168
1.7.5. 如何为一个层设置 170
1.7.6. 如何为一个层设置DotDensity Renderer ................................ 173
1.8. Layout和打印 ......................................................................... 175
1.8.1. 如何在Page Layout上添加Text ............................................. 175
1.8.2. 如何在Page Layout上添加Legend ......................................... 176
1.8.3. 如何在Page Layout上添加North Arrow ................................ 179
1.8.4. 如何在Page Layout上添加Scale bar .................................... 180
1.8.5. 如何在Page Layout上添加Scale Text .................................. 182
1.8.6. 如何在Page Layout上添加Picture ........................................ 184
1.8.7. 如何创建、删除地图网格(Map Grid) ....................................... 185
1.8.8. 如何设置Layout中MapFrame的外观风格属性 ........................ 187
1.8.9. 何设置Layout中Page的边框（Border）和背景（Background） 189
1.8.10. 如何设置打印纸张的大小和方向 .............................................. 192
1.9. 坐标系统 .................................................................................. 193
1.9.1. 如何在ArcMap中设置地理坐标系和投影坐标系 ...................... 193
1.9.2. 如何修改层的坐标系统 ............................................................. 194
1.9.3. 如何把Polygon的顶点从经纬度坐标转换到平面直角坐标 ...... 196
1.10. ArcGis相关文件 ...................................................................... 198
1.10.1. 如何夹载grf文件 .................................................................... 198
1.10.2. 如何新建指向Shape文件的lyr文件 ....................................... 199
1.10.3. 如何新建指向GeoDataBase文件的lyr文件 ............................ 200
1.10.4. 如何加载mxd文件 .................................................................... 202
1.10.5. 如何加载Apr文件(ArcView32) ................................................ 203
1.10.6. 如何加载lyr文件 .................................................................... 204
1.10.7. lyr文件的属性的设置 .............................................................. 205
1.11. 其他 .......................................................................................... 208
1.11.1. 如何创建简单的Column Chart ................................................. 208
-4-
1.11.2. 如何将数据输出到Excel .......................................................... 209
1.11.3. 如何把Labels转换为Annotation ........................................... 211
1.11.4. 如何把Annotation转换为Polygon Features ......................... 215
1.11.5. 如何设置Featurelayer的Label ............................................. 218
1.11.6. 如何设置图层显示的透明度 ..................................................... 220
1.11.7. 如何过滤层中要显示的Features ............................................. 220
1.11.8. 如何在MapControl中新建一个Document并且保存 ................. 221
2.
2.1.
2.2.
2.3.
2.4.
2.5.
2.6.
2.7.
2.8.
2.9.
2.10.
提高篇 .............................................. 224
缩略图的实现 ........................................................................... 224
FeatureLayer显示Symbol的定制 ........................................ 224
空间查询的综合应用 ................................................................ 224
图形编辑的综合应用 ................................................................ 224
グラフの重ね合わせ表示と印刷 .............................................. 224
バッファ処理 ........................................................................... 233
Voronio作成 ............................................................................ 239
数据处理加速—地图分块处理.................................................. 239
MapControl的使用 ................................................................. 240
运用PageLayout控件打印图形 .............................................. 240
附录 ArcGIS的GUID一览表 ...................................... 240
基础篇
1.1. 开发环境
1.1.1. 如何在ArcMap的VBA环境中编程
ArcMap是ArcGIS家族的成员之一，它内置了一种集成编程环境―VBA（Visaul Basic for Apllications）。通过VBA编程，用户不但可以扩展ArcMap的菜单、工具条等，而且可以完成大多数用户的特定需求。
-5-
ArcMap中VBA编程的方法有两种,一种是写VBA宏,另一种是创建UIControl并在其事件中写入实现用户需求的代码。下面列出两种方法的一般步骤。
方法一：写VBA宏（直接在VBA编辑器中编辑函数和过程）
1、如图1，单击菜单栏中的 Editor>项, 直接启动ArcMap的VBA编辑器；或者选择 图1 启动Macro对话框/启动VBA编辑器 -6- 图2 Macro对话框 2、在图3所示的窗口中，用户可以根据实际选择在Normal节点或者Project节点的ThisDocument、Forms、Modules中编写宏（函数或过程），Normal节点下所写的宏系统自动保存，除非用户删除，否则它将始终存在并在任何工程中都有效；而在Project节点下所写得宏随工程保存（如不保存工程，则宏也将不被保存），并只在工程中有效。 图3 VBA编辑器（VBE） -7- 3、运行VBA宏 在VBA编辑器中写好VBA代码后，有两种方式运行：第一，点击VBA编辑器工具条中的（运行）按钮，可立即运行写好的代码；第二，退出VBA编辑器，重新启动Macro对话框，如图2，选择要运行的VBA宏名称，点击 方法二：创建UIControl（交互式VBA编程） 1、用鼠标右击任何工具栏（条），在弹出的上托式菜单中选择 图4 启动“Customize”对话框 2、切换到“Customize”对话框的“Commands”页，选中“UIControls”后点击 3、在“New UIControl”对话框中，用户可根据需要选择UIControl类型： UIButtonControl：创建Button； UIToolControl：创建与Map交互的Tool； UIEditBoxControl：创建EditBox； -8- UIComboBoxControl：创建ComboBox。 最后点击 图5 Customize对话框 图6 New UIControl对话框 4、UIControl创建后，在图5所示的“Customize”对话框选中UIControl并将其拖置到任意工具条上，用户便可象使用系统已有的Control一样使用所创建的UIControl。 -9- 1.1.2. 如何在VB环境中利用ArcObjects组件开发ActiveX DLL 1.1.1节讨论了如何在ArcGis的VBA环境中编程，虽然通过这种方式可以完成大多数用户的定制需求，但是，在某些情况下，对于特殊的应用，用户需要脱离ArcGIS环境而在VB开发环境中开发外部独立的应用程序，这种外部独立的应用程序有两种形式： ActiveX DLL和Standard EXE。Standard EXE的开发将在1.1.4中讨论，本节将讨论ActiveX DLL的开发，其关键是引用ArcObjects对象库和实现ArcObjects接口（例如ICommand,ITool,IToolBar等）。 下面介绍在VB环境利用ArcObjects组件开发ActiveX DLL的一般步骤。 1、启动VB开发环境，在图7所示的“New Project”对话框中选择“ActiveX DLL”项,并点击<打开>按钮，进入VBE环境。 图7 New Project对话框 2、引用ArcObjects对象库：首先点击 -10- 图8 启动对象库引用对话框 图9 对象库引用对话框 -11- 3、对象库引用对话框（图9）中选中“Esri ArcMap Object Library ”和“Esri Object Library” 两项，并点击 4、一般在类模块中写入实现特定ArcObjects接口的代码，如图10，然后运行 图10 类模块编辑窗口 图11 生成DLL文件 1.1.3. 如何在ArcMap中加载利用ArcObjects组件开发的ActiveX DLL 用户通过1.1.2中介绍的方法开发好一个ActiveX DLL程序后，便可根据实际需要，在ArcMap环境下加载这个ActiveX DLL程序。其一般步骤如下： -12- 1、用鼠标右击任何工具栏（条），点击弹出的上托式菜单中的 2、在Customize对话框中，根据被加载DLL的类型切换到“Toolbars”或者“Commands”页（参见图5），然后点击 3、在“打开文件”对话框中（Windows通用“打开文件”对话框，图略），选择被加载的Dll文件，并点击<打开>按钮。 4、如果加载是“Commands”,则在图5所示的对话框中显示加载的Command，并可以将其拖置于任何工具条上；如果加载是“ToolBars”,则在图12所示的对话框中显示加载的ToolBar,选中后即可在ArcMap中显示。 图12 加载ToolBar 1.1.4. 如何在VB环境中利用ArcObjects控件开发EXE 利用ArcObjects控件开发EXE的前三步类似于1.1.2中开发“Acrtive Dll”的前三步，唯一不同的是在“New Project”对话框中选择“Standard EXE”。 4、点击 -13- 图13 打开Components对话框 5、在“Components”对话框中，切换到Controls页，并选中“ESRI MapControl”项，点击<应用>或<确定>按钮，如图14。 图14 Components对话框 6、如图15所示，加载MapControl控件之后，在VBE的控件面板中出现了MapControl控件图标，用户便可以象在Form中添加Button一样在Form中添加MapControl控件，并利用它开发EXE。 -14- 图15 添加MapControl控件 1.2. 用户界面 1.2.1. 如何创建定制的按钮(Button) 本例要实现的是如何创建定制的按钮(Button)。 要点 用户通过在类模块中实现ICommand接口来创建定制的按钮（COM command）。ICommand接口包括 caption、 name、 category、 bitmap、 message（StatusBarr的提示信息）、 tooltip（微帮助）、 help context id 、help file、enabled以及checked等十个属性和OnCreate、 OnClick两个事件。从Icommand接口的OnCreate事件中获取的ArcMap的Application实例必须用一个公共变量保存，以便在其它事件中(或者其它接口的事件中甚至整个工程中)使用。 ·OnCreate事件的参数hook传入的是一个Object，也就是ArcMAP的Application实例，可把它赋给一个IApplication接口的变量，便获得了ArcMAP的实例。 ·在OnClick事件中写入相关代码，表示按下按钮时要实现的功能. -15- 程序说明 程序在类模块中实现Icommand接口来创建自己的按钮(Button) 代码 Option Explicit '实现Icommand接口 Implements ICommand Dim m_pPicture as Picture Dim m_pApplication As IApplication Private Sub Class_Initialize() '调入.RES文件中ID为101的BitMap作为该按钮的显示图片 Set m_pPicture = LoadResPicture(101, vbResBitmap) End Sub Private Property Get ICommand_Bitmap() As _HANDLE ICommand_Bitmap = m_pPicture End Property Private Property Get ICommand_Caption() As String ICommand_Caption = "Create Button" End Property Private Property Get ICommand_Category() As String ICommand_Category = " Create Button " End Property Private Property Get ICommand_Checked() As Boolean End Property Private Property Get ICommand_Enabled() As Boolean ICommand_Enabled = True End Property Private Property Get ICommand_HelpContextID() As Long End Property Private Property Get ICommand_HelpFile() As String End Property Private Property Get ICommand_Message() As String End Property Private Property Get ICommand_Name() As String ICommand_Name = " CreateButton " End Property Private Sub ICommand_OnClick() '加入按下按钮时实现的功能代码。在这里， '按钮按下时显示ArcMap的Document的Tittle Dim pDocument As IDocument -16- Set pDocument = m_nt MsgBox End Sub Private Sub ICommand_OnCreate(ByVal hook As Object) '获取ArcMap的Application实例 Set m_pApplication = hook End Sub Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = " Create Button " End Property 1.2.2. 如何创建定制的Tool 本例要实现的是如何创建定制的Tool 要点 用户在类模块中实现Icommand（参见1.2.1）和ITool接口。ITool接口包括 mouse move, mouse button press/release, keyboard key press/release, double-click以及right click等事件、Cursor属性和Refresh方法。 Tool既具有Button的功能，又具有与ArcMAP界面交互的功能，Button的功能代码必须写在Icommand的OnClick事件中，而所有实现交互功能的代码必须写在Itool接口的各个事件中。Itool接口的各个事件,用户可以在其中写入相关代码，表示用户与ArcMAP界面交互时一旦触发某事件要实现的功能。 程序说明 程序在类模块中实现Icommand和Itool接口来创建自己的Tool. 代码 Option Explicit '实现Icommand和Itool接口 Implements ICommand Implements ITool Dim m_pApplication As IApplication Dim m_pBitmap As IPictureDisp Dim m_pCursor As IpictureDisp Private Sub Class_Initialize() Set m_pBitmap = LoadResPicture(101, 0) '从.RES文件中调入ID为102的图片作为按下Tool后的MouseCursor Set m_pCursor = LoadResPicture(102, 2) End Sub Private Property Get ICommand_Bitmap() As _HANDLE ICommand_Bitmap = m_pBitmap -17- End Property Private Property Get ICommand_Caption() As String ICommand_Caption = "MyTool" End Property Private Property Get ICommand_Category() As String ICommand_Category = "MyCustomTools" End Property Private Property Get ICommand_Checked() As Boolean End Property Private Property Get ICommand_Enabled() As Boolean ICommand_Enabled = True End Property Private Property Get ICommand_HelpContextID() As Long End Property Private Property Get ICommand_HelpFile() As String End Property Private Property Get ICommand_Message() As String ICommand_Message = "This is my custom tool" End Property Private Property Get ICommand_Name() As String ICommand_Name = "MyCustomTool_MyTool" End Property Private Sub ICommand_OnClick() '加入按下按钮时实现的功能代码 MsgBox "Clicked on my command" End Sub Private Sub ICommand_OnCreate(ByVal hook As Object) '获取ArcMAP的Application实例 Set m_pApplication = hook End Sub Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = "MyTool" End Property Private Property Get ITool_Cursor() As _HANDLE ITool_Cursor = m_pCursor End Property Private Function ITool_Deactivate() As Boolean '如果ITool_Deactivate设为False，则Tool不可用 ITool_Deactivate = True End Function -18- Private Function ITool_OnContextMenu(ByVal X As Long, ByVal Y As Long) As Boolean '在这里可以加入用户代码，点击Mouse右键时显示一个定制的context menu End Function Private Sub ITool_OnDblClick() '在这里加入Mouse双击时的功能代码 End Sub Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long) End Sub Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long) End Sub Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入Mouse单击时的功能代码 If Button = 1 Then Dim pPoint As IPoint Dim pMxApplication As IMxApplication Set pMxApplication = m_pApp Set pPoint=oint(X, Y) m_e(0) = Str(pPoint.X) & "," & Str(pPoint.Y) End If End Sub Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入Mouse移动时的功能代码 m_e(0) = "ITool_OnMouseMove" End Sub Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入释放Mouse时的功能代码 m_e(0) = "ITool_OnMouseUp" End Sub Private Sub ITool_Refresh(ByVal hDC As _HANDLE) End Sub 1.2.3. 如何创建定制的工具条(Tool Bar) 本例要实现的是如何创建定制的工具条(Tool Bar)。就必须在类模块中实现IToolBarDef接口。IToolBarDef接口包括 Caption、ItemCount及Name三个属性和GetItemInfo方法。 要点 通过在类模块中实现IToolBarDef接口。IToolBarDef接口包括 Caption、-19- ItemCount及Name三个属性和GetItemInfo方法。 ·ItemCount属性表示ToolBar显示的条目(Button、Tool或其它控件)数。 · GetItemInfo方法定义工具条上各条目的CLSID，其中，参数pos表示条目在ToolBar中的位置，itemDef 是定义相应位置的条目的IItemDef 对象。 ·工具条条目的CLSID分为两种： 1、系统CLSID，代表ArcGIS的一个功能，其引用方式为"esriCore.命令名称"，如"aCommand"、"veCommand"等。 2、用户定制CLSID，表示用户自己定义的功能。其引用方式为"工程名称.定制功能类名称"，如" "。必须注意，这里“定制功能类名称”是工程中实现的一个功能类名称，“工程名称”即为当前工程的名称（不是DLL文件名，也不是工具条的名称），每次新建一个工程时，系统默认的工程名在某些情况下无法使用（在中文版的VB中是一个乱字符），必须改名后方能用。 程序说明 程序在类模块中实现IToolBarDef接口来创建自己的工具条(ToolBar)。 代码 Option Explicit Implements IToolBarDef Private Property Get IToolBarDef_Caption() As String IToolBarDef_Caption = "CustomToolBar" End Property Private Sub IToolBarDef_GetItemInfo(ByVal pos As Long, ByVal itemDef As _ ef) '这里假设在当前工程(工程名称为ToolBarDef)中定义了一个类模块(名为ClsBar)， '它实现了Icommand接口(可参照1.2.1) Select Case pos Case 0 '用户自定义条目 = "" = False Case 1 '系统条目 = "aCommand" = False End Select End Sub Private Property Get IToolBarDef_ItemCount() As Long IToolBarDef_ItemCount = 2 End Property -20- Private Property Get IToolBarDef_Name() As String IToolBarDef_Name = "CustomToolBar" End Property 1.2.4. 如何创建定制的MultiItem 本例要实现的是如何创建定制的MultiItem。 要点 需要实现IMultiItem接口，但不需要同时实现Icommand接口。IMultiItem接口包括Caption,itemCaption,ItemBitmap,ItemEnabled,ItemChecked, Message及Name等属性和OnItemClick, OnPopup事件。 ·itemCaption,ItemBitmap,ItemEnabled,ItemChecked等属性的参数index表示当前Item的下标索引。 ·OnPopup事件的参数hook同Icommand接口的OnCreate事件的参数hook一样，传入ArcGIS的Application实例，同时，该事件返回将要显示的Item数目。 ·OnItemClick事件的参数Index表示用户当前点击的Item的索引，用户根据该索引分别定义点击各个Item时实现的功能。 程序说明 程序在类模块中实现IMultiItem接口来创建定制自己的MultiItem。 代码 Option Explicit Implements IMultiItem Private m_pApp As IApplication 'ArcMap的Document Private m_pMxDoc As IMxDocument '当前Focus Map Private m_pMap As IMap 'Map中的层数 Private m_pLayerCnt As Long Private Property Get IMultiItem_Caption() As String IMultiItem_Caption = "ZoomToLayers" End Property Private Property Get IMultiItem_HelpContextID() As Long End Property Private Property Get IMultiItem_HelpFile() As String End Property -21- Private Property Get IMultiItem_ItemBitmap(ByVal Index As Long) As _HANDLE End Property Private Property Get IMultiItem_ItemCaption(ByVal Index As Long) As String Dim i As Integer ' 遍历每一个层 For i = 0 To m_pLayerCnt - 1 ' 如果层号与当前Item的Index相同，就设置该Item的Caption If Index = i Then IMultiItem_ItemCaption = "Zoom to " & m_(i).Name End If Next End Property Private Property Get IMultiItem_ItemChecked(ByVal Index As Long) As Boolean End Property Private Property Get IMultiItem_ItemEnabled(ByVal Index As Long) As Boolean Dim i As Integer ' 遍历每一个层 For i = 0 To m_pLayerCnt - 1 '如果层号与当前Item的Index相同,则当前Item的Enable根据该层的Visible设置。 If Index = i Then If m_(i).Visible Then IMultiItem_ItemEnabled = True End If End If Next End Property Private Property Get IMultiItem_Message() As String IMultiItem_Message = "Zooms to the layer." End Property Private Property Get IMultiItem_Name() As String IMultiItem_Name = "ZoomMulti" End Property Private Sub IMultiItem_OnItemClick(ByVal Index As Long) Dim i As Integer Dim pEnv As IEnvelope Dim m_BookMark As IAOIBookmark ' 遍历每一个层 For i = 0 To m_pLayerCnt – 1 '如果层号与当前Item的Index相同,则以该层的AreaOfInterest 为范围执行Zoom If Index = i Then Set pEnv = m_(i).AreaOfInterest Set m_BookMark = New AOIBookmark Set m_on = pEnv m_ m_pMap m_h End If -22- Next End Sub Private Function IMultiItem_OnPopup(ByVal hook As Object) As Long Set m_pApp = hook ' 获取Map中的层数 Set m_pMxDoc = m_nt Set m_pMap = m_ap m_pLayerCnt = m_ount ' 显示的Item数等于层数 IMultiItem_OnPopup = m_pLayerCnt End Function 1.2.5. 如何创建定制的菜单(Menu) 本例要实现的是如何创建定制的菜单(Menu)。 要点 用户通过在类模块中实现IMenuDef接口来创建定制的菜单(Menu),如果要使菜单出现在Customize Dialog的Menus类型中，必须同时实现IrootLevelMenu接口，它表明菜单为root menu。IMenuDef接口包括 Caption、ItemCount及Name三个属性和GetItemInfo方法。类似IToolBarDef(参照1.2.3) 程序说明 程序在类模块中实现IMenuDef接口来创建定制的菜单(Menu)。 代码 Option Explicit 'Implement the IMenuDef interface and IRootLevelMenu interface Implements IMenuDef Implements IRootLevelMenu Private Property Get IMenuDef_Caption() As String ' Set the string that appears as the menu's title IMenuDef_Caption = "MyMenu" End Property Private Sub IMenuDef_GetItemInfo(ByVal pos As Long, _ ByVal itemDef As ef) ' Define the commands that will be on the menu. The built-in ArcMap ' Full Extent command, and Fixed Zoom In command are added to this custom menu. ' ID is the ClassID of the command. Group determines whether the command ' begins a new group on the menu Select Case pos Case 0 = "titem" = False Case 1 -23- = "tentCommand" = True Case 2 = "FixedCommand" = False End Select End Sub Private Property Get IMenuDef_ItemCount() As Long ' Set how many commands will be on the menu IMenuDef_ItemCount = 3 End Property Private Property Get IMenuDef_Name() As String ' Set the internal name of the menu. IMenuDef_Name = "MyMenu" End Property 1.2.6. 如何创建定制的ToolControl 本例要实现的是如何创建定制的ToolControl。ToolControl是指具有ComboBox的下拉列表 或 EditBox的编辑功能的一类控件。要创建定制的ToolControl，必须在类模块中实现ICommand 和 IToolControl接口。IToolControl接口包括hWnd属性和OnDrop, OnFocus事件。 要点 ·IToolControl接口的hWnd属性，接受一个Window Handle。 ·IToolControl接口的OnDrop事件，支持ToolControl的拖放，传入参数barType表示Bar类型。 ·IToolControl接口的OnFocus事件，传入IcompletionNotify类型的参数complete，可以通过执行IcompletionNotify接口的SetComplete方法告之ArcMAP，ToolControl可以失去Focus。 程序说明 本例中涉及三个模块，详细描述如下,其中，在类模块中实现了IToolBarDef接口来创建自己的ToolControl。 代码 '1、模块，定义选中Combox某一项之后实现的功能。要求在Form上放置一个 'ImageComb控件（名为ImageCombo1）和一个ImageList控件（名为ImageList1），并在ImageList1 '中添加三张图片。 Private Sub Form_Load() ' 设置ImageCombo1的选择Item ist = ist1 -24- 1, "Red", "Red" 2, "Blue", "Blue" 3, "Green", "Green" tems(1).Image = 1 tems(2).Image = 2 tems(3).Image = 3 End Sub Private Sub ImageCombo1_Click() ' 选择颜色 Dim sel As Variant sel = edItem Dim color As Variant Select Case sel Case "Blue" color = vbBlue Case "Red" color = vbRed Case "Green" color = vbGreen End Select Dim pDocument As IMxDocument Set pDocument = g_nt ' 设置颜色 Dim pRgbColor As IrgbColor Set pRgbColor = New RgbColor = color ' 改变选中部分的颜色 Dim pSelectionEnvironment As ISelectionEnvironment Set pSelectionEnvironment = New SelectionEnvironment Set tColor = pRgbColor ' 刷新视图 h ' 通知ArcMap,ToolControl现在可以失去Focus g_plete End Sub ' 2、模块，定义工程中用到的全局变量。 Option Explicit Public g_pApplication As IApplication Public g_pCompletionNotify As IcompletionNotify ' 3、模块，实现接口Icommand和IToolControl。 Option Explicit Implements ICommand Implements IToolControl Private Property Get ICommand_Bitmap() As _HANDLE End Property Private Property Get ICommand_Caption() As String ICommand_Caption = "Custom ImageCombo" End Property -25- Private Property Get ICommand_Category() As String ICommand_Category = "Developer Samples" End Property Private Property Get ICommand_Checked() As Boolean End Property Private Property Get ICommand_Enabled() As Boolean ICommand_Enabled = True End Property Private Property Get ICommand_HelpContextID() As Long End Property Private Property Get ICommand_HelpFile() As String End Property Private Property Get ICommand_Message() As String ICommand_Message = "Change feature selection color" End Property Private Property Get ICommand_Name() As String ICommand_Name = "DevelperSamples_CustomImageCombo" End Property Private Sub ICommand_OnClick() End Sub Private Sub ICommand_OnCreate(ByVal hook As Object) Set g_pApp = hook End Sub Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = "Change Selection Color" End Property Private Property Get IToolControl_hWnd() As _HANDLE '将ombo1的Window Handle赋给IToolControl_hWnd IToolControl_hWnd = End Property Private Function IToolControl_OnDrop(ByVal barType As dBarType) As Boolean '仅能将ToolControl拖放到ToolBar上 If barType = esriCmdBarTypeToolbar Then IToolControl_OnDrop = True End If End Function Private Sub IToolControl_OnFocus(ByVal complete As etionNotify) Set g_pCompletionNotify = complete End Sub -26- 1.2.7. 如何创建定、使用制的可停靠窗口(Dockable Window) 本例要实现的是如何创建定制的可停靠窗口(Dockable Window) 要点 用户通过在类模块中实现IDockableWindowDef接口来创建定制的可停靠窗口(Dockable Window)。IDockableWindowDef接口包括Caption、ChildHWND，UserData及Name等属性和OnCreate、OnDestroy事件。 ·ChildHWND属性表示可停靠窗口包含的Window的Handle。 ·OnCreate事件的参数hook传入ArcGIS的Application实例。 ·创建并注册可停靠窗口的步骤： 1、实现IdockableWindowDef接口(参见实例)； 2、编译成DLL； 3、调用windows目录下system32子目录下的用下面的形式注册编译好的DLL： win目录 <路径><文件名>.dll 4、运行 Catregory Manager中找到ESRI Mx Dockable Window,点击Add Object…按钮将上面注册的DLL文件加入，并选中实现IdockableWindowDef接口的类名即可。 程序说明 类模块 ClsDockableWindow只是创建与注册可停靠窗口，但还不能用，还必须定义一个IdockableWindow接口的变量引用注册的类（必须用IdockableWindowsManager接口的GetDockableWindow获取，其ID号用"实现IdockableWindowDef接口的工程名project1. 实现IdockableWindowDef接口的类名class1"）。 代码 '类模块 ClsDockableWindow Option Explicit Implements IDockableWindowDef Dim m_pApplication As IApplication Private Property Get IDockableWindowDef_Caption() As String IDockableWindowDef_Caption = "Dockable Window" End Property -27- Private Property Get IDockableWindowDef_ChildHWND() As _HANDLE '将FrmDWin窗口的Handle赋给IDockableWindowDef_ChildHWND IDockableWindowDef_ChildHWND = End Property Private Property Get IDockableWindowDef_Name() As String IDockableWindowDef_Name = "docwin" End Property Private Sub IDockableWindowDef_OnCreate(ByVal hook As Object) Set m_pApplication = hook End Sub Private Sub IDockableWindowDef_OnDestroy() Set m_pApplication = Nothing End Sub Private Property Get IDockableWindowDef_UserData() As Variant End Property '类模块 class1 Option Explicit Implements ICommand Dim m_pApp As IApplication Dim m_pDWMgr As IDockableWindowManager Dim m_pDWin As IDockableWindow Private Property Get ICommand_Bitmap() As _HANDLE End Property Private Property Get ICommand_Caption() As String ICommand_Caption = "Dockable Window" End Property Private Property Get ICommand_Category() As String ICommand_Category = "Dockable Window" End Property Private Property Get ICommand_Checked() As Boolean End Property Private Property Get ICommand_Enabled() As Boolean ICommand_Enabled = True End Property Private Property Get ICommand_HelpContextID() As Long End Property Private Property Get ICommand_HelpFile() As String End Property Private Property Get ICommand_Message() As String End Property -28- Private Property Get ICommand_Name() As String ICommand_Name = "DocWin" End Property Private Sub ICommand_OnClick() m_ Not m_ble End Sub Private Sub ICommand_OnCreate(ByVal hook As Object) Set m_pApp = hook ' QI(Dockable Window) Set m_pDWMgr = hook Dim pid As New UID = "kablewindow" Set m_pDWin = m_kableWindow(pid) End Sub Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = "Dockable Window" End Property 1.2.8. 如何创建、使用定制的Extension 本例要实现的是如何创建、使用定制的Extension。 要点 用户需要实现IExtension接口来创建定制的Extension。IExtension接口包括Name属性和startup和shutdown事件。 ·创建并注册Extension的步骤： 1．实现IExtension接口； 2．编译成DLL； 3．调用windows目录下system32子目录下的用下面的形式注册编译好的DLL win目录 <路径><文件名>.dll 4．运行 Catregory Manager中找到ESRI Mx Extensions,点击Add Object…按钮将上面注册的DLL文件加入，并选中实现IExtension接口的类名即可。 程序说明 用户通过在类模块中实现IExtension接口来创建定制的Extension。Extension将在ArcMap打开时自动加载，在ArcMap关闭时自动卸载。 -29- 代码 Option Explicit Implements IExtension Dim m_pApplication As IApplication ' Need to listen for the MxDocument events Dim WithEvents m_pDocument As MxDocument Private Property Get IExtension_Name() As String IExtension_Name = "My Extension" End Property Private Sub IExtension_Shutdown() ' Clear the reference to the Application and MxDocument Set m_pApplication = Nothing Set m_pDocument = Nothing End Sub Private Sub IExtension_Startup(initializationData As Variant) ' This extension is an ArcMap Extension. When this extension in loaded on ' ArcMap startup, initializationData is passed in as a reference to the ' Application object Set m_pApplication = initializationData 'Start listening for the MxDocument events. Set m_pDocument = m_nt End Sub Private Function m_pDocument_NewDocument() As Boolean ' Do something when a new document is created MsgBox "Creating a new document." End Function Private Function m_pDocument_OpenDocument() As Boolean ' So something when a document is opened. MsgBox "Opening a document" End Function 1.2.9. 如何使用状态条(StatusBar)与进度条(ProgressBar) 本例要演示的是如何使用状态条(StatusBar)与进度条(ProgressBar)。实现后的结果为在ArcMap中，状态条位于其底部，它显示ArcMAP当前状态的信息，包含进度条。 要点 一般情况下，通过ArcMAP的Application实例获取IstatusBar的实例,然后再通过StatusBar获取IprogressBar的实例,并将IprogressBar的实例赋给IstepProgressor类型的变量。 -30- 程序说明 运行函数ShowProgress将在ArcMap的下方添加一个状态条(StatusBar)和进度条(ProgressBar)。 代码 Sub ShowProgress() On Error GoTo err1 Dim pDocument As IMxDocument Dim pMap As IMap Dim pLayer As ILayer Dim pFeatureLayer As IFeatureLayer Dim pFeatureCursor As IFeatureCursor Dim pFeatureClass As IFeatureClass Dim pFeature As IFeature Dim dSum As Double Dim lFieldIndex As Long Dim lNumFeat As Long Dim dInterval As Double Set pDocument = nt Set pMap = ap Set pLayer = (0) Set pFeatureLayer = pLayer Set pFeatureClass = eClass Set pFeatureCursor = (Nothing, True) Dim pStatusBar As IStatusBar Set pStatusBar = Bar Dim pStepProgressor As IStepProgressor Set pStepProgressor= ssBar lNumFeat = eCount(Nothing) dInterval = lNumFeat / 100 Set pFeature = ature ' 字段名"FID"用户根据实际而改变 lFieldIndex = eld("FID") Dim PauseTime, Start, Finish, TotalTime, i PauseTime = 0.5 ge = 1 ge = lNumFeat lue = dInterval For i = 1 To lNumFeat dSum = dSum + (lFieldIndex) Set pFeature = Nothing Set pFeature = ature on = i e = "Reading record " & Str(i) & ". Sum =" & Str(dSum) Start = Timer Do While Timer < Start + PauseTime DoEvents Loop -31- Next Exit Sub err1: MsgBox ption End Sub 1.2.10. 如何使用ArcGIS的对话框 添加对话框可以通过相应的接口实现。比如“添加数据对话框”使用IaddDataDialog接口，“生成点坐标对话框” 使用ICoordinateDialog接口，“生成字符串对话框”使用IGetStringDialog接口，“生成数值对话框”使用INumberDialog接口等等。本例以添加数据对话框(Add Data Dialog)为例，讲述对话框是如何通过接口实现添加的。 要点 用户通过实现IaddDataDialog接口来创建定制的添加数据对话框，IaddDataDialog接口包括Document和Map属性和Show事件。 程序说明 在程序中除了必须生成IaddDataDialog接口的实例外，还必须指定对话框的Document和Map。当为AddDataDialog指定Document和Map之后，系统会自动将用户选择的数据加入到指定Document和Map中。最后实现在ArcMap中添加数据的对话框。 代码 Sub ShowProgress() Dim mDocument As IMxDocument Dim mAddDataDialog As IAddDataDialog Set mAddDataDialog = New AddDataDialog Set mDocument = ThisDocument nt = mDocument = ap , True End Sub 1.2.11. 如何调用ArcMap中现有的功能 如何调用ArcMap中现有的功能，比如菜单栏、工具栏中的某些功能。这些都可以通过UID来实现。本例是通过UID调用“另存为”功能。 可以通过两种方法得到UID: 方法一：运用ArcID模块 -32- 要点 通过ArcID获得UID,ArcID是ArcMap的VBA中的模块。只需要知道要调用功能的名称运用代码就可以实现。 程序说明 程序通过运用ArcID模块和命令名称来实现调用“另存为”的功能。 代码 Sub ExecuteCmd() Dim pCommandItem As ICommandItem ' Use ArcID module and the Name of the SaveAs command Set pCommandItem = (_SaveAs) e End Sub 方法二：直接写代码 要点 通过直接写代码获得UID实现调用功能。 程序说明 写入文件菜单项的GUID(CLSID或ProgID)来调用文件菜单项，同时还需要通过设置Subtype的值来调用文件菜单项的“另存为”功能。 代码 Sub ExecuteCmd2() Dim pUID As New UID Dim pCommandItem As ICommandItem ' Use the GUID of the Save command = "{119591DB-0255-11D2-8D20-080009EE4E51}" ' or you can use the ProgID ' = "MenuItem" e = 3 Set pCommandItem = (pUID) e End Sub 1.2.12. 如何创建放大镜(虫眼) 本例要实现的是如何创建放大镜(虫眼)，将所选区域放大一定的倍数。 要点 用户通过定义IMapInset、IMapInsetWindow、IDataWindowFactory三个接口，运用它们的方法、属性来创建放大镜(虫眼)。 程序说明 运用这个子程序生成了一个新的放大镜窗口，在本例中将放大率设定为200%-33- 代替原来的400%。 代码 Public Sub CreateMagnifierWindow() Dim pMapInset As IMapInset Dim pMapInsetWindow As IMapInsetWindow Dim pDataWindowFactory As IDataWindowFactory Set pDataWindowFactory = New MapInsetWindowFactory If ate(Application) Then Set pMapInsetWindow = (Application) Set pMapInset = et 'Set the zoom percent to 200% rcent = 200 True End If End Sub 1.3. GeoDataBase 1.3.1. 如何加载Shape文件 本例实现的是在ArcMap中连接指定的Shape文件，并将其加载到当前激活的Map中。 要点 通过FeatureLayer类实现IFeatureLayer接口对象，设置eClass属性和Name属性，使用er方法将新层添加到当前地图。利用IWorkspaceFacktory接口、IFeatureWorkspace接口和IFeatureLayer接口实现连接Shape文件 程序说明 函数OpenShapeFile根据输入的Shape文件路径sFilePath，将文件名为sFileName的Shape文件连接到当前激活的Map中去。 代码 Private Sub OpenShapeFile(ByVal sFilePath As String, ByVal sFileName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim pFeatureWorkspace As IFeatureWorkspace Dim pFeatureLayer As IFeatureLayer Dim pMxDocument As IMxDocument Dim pMap As IMap Dim sDir As String On Error GoTo ErrorHandler: sDir = Dir(sFilePath & "" & sFileName & ".shp") If (sDir = "") Then sDir = Dir(sFilePath & "" & sFileName) If (sDir = "") Then MsgBox ("文件不存在") -34- Exit Sub End If End If 'Create a new ShapefileWorkspaceFactory object and open a shapefile folder Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pFeatureWorkspace = omFile(sFilePath, 0) 'Create a new FeatureLayer and assign a shapefile to it Set pFeatureLayer = New FeatureLayer Set eClass = atureClass(sFileName) = ame 'Add the FeatureLayer to the focus map Set pMxDocument = nt Set pMap = ap er pFeatureLayer Exit Sub ErrorHandler: MsgBox ption End Sub Private Sub UIButtonControl1_Click() Dim pVBProject As VBProject On Error GoTo ErrorHandler: Set pVBProject = ect OpenShapeFile me & "........" & "data", "Continents" Exit Sub ErrorHandler: MsgBox ption End Sub 1.3.2. 如何在ArcMap中加入Text和dBASE文件 本例实现的是如何在当前的ArcMap中加入Text文件和dBASE文件。 要点 首先为Text文件或dBASE文件创建一个与之对应的ITable接口对象，然后通过IMap实例获得IStandaloneTable接口对象和IStandaloneTableCollection接口对象，并设置其属性，最后使用ndaloneTable方法将Text文件或dBASE文件加入到当前的ArcMap中。加入Text文件或dBASE文件的区别仅在于创建ITable对象时IWorkspaceFactory的类型不同，加入Text文件时是TextFileWorkspaceFactory类型，加入dBASE文件时是ShapefileWorkspaceFactory类型。 主要用到了IWorkspaceFactory接口，IWorkspace接口，IFeatureWorkspace-35- 接口，ITable接口，IStandaloneTable接口和IStandaloneTableCollection接口。 程序说明 函数AddTextFile通过文件路径sFilePath和文件名sFileName找到Text文件并为其创建ITable对象 函数AddDBASEFile通过文件路径sFilePath和文件名sFileName找到dBASE文件并为其创建ITable对象 函数Add_Table_TOC将ITable对象pTable加入到当前的ArcMap中。 代码 Private Sub AddTextFile(ByVal sFilePath As String, ByVal sFileName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim pWorkspace As IWorkspace Dim pFeatureWorkspace As IFeatureWorkspace Dim pTable As ITable Dim sDir As String On Error GoTo ErrorHandler: sDir = Dir(sFilePath & sFileName & ".txt") If (sDir = "") Then MsgBox (sFileName & ".txt" & " 文件不存在") Exit Sub End If 'Get the ITable from the geodatabase Set pWorkspaceFactory = New TextFileWorkspaceFactory Set pWorkspace = omFile(sFilePath, 0) Set pFeatureWorkspace = pWorkspace Set pTable = ble(sFileName & ".txt") 'Add the table Add_Table_TOC pTable Exit Sub ErrorHandler: MsgBox ption End Sub Private Sub AddDBASEFile(ByVal sFilePath As String, ByVal sFileName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim pWorkspace As IWorkspace Dim pFeatureWorkspace As IFeatureWorkspace Dim pTable As ITable On Error GoTo ErrorHandler: 'Get the ITable from the geodatabase Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pWorkspace = omFile(sFilePath, 0) Set pFeatureWorkspace = pWorkspace -36- Set pTable = ble(sFileName) 'Add the table Add_Table_TOC pTable Exit Sub ErrorHandler: MsgBox ption End Sub Private Sub Add_Table_TOC(pTable As ITable) Dim pDoc As IMxDocument Dim pMap As IMap Dim pStandaloneTable As IStandaloneTable Dim pStandaloneTableC As IStandaloneTableCollection On Error GoTo ErrorHandler: Set pDoc = ThisDocument Set pMap = ap 'Create a new standalone table and add it 'to the collection of the focus map Set pStandaloneTable = New StandaloneTable Set = pTable Set pStandaloneTableC = pMap ndaloneTable pStandaloneTable 'Refresh the TOC Contents Exit Sub ErrorHandler: MsgBox ption End Sub Private Sub UIButtonControl1_Click() Dim pVBProject As VBProject On Error GoTo ErrorHandler: Set pVBProject = ect 'Add text file to ArcMap. Dont include .txt extension AddTextFile me & "........" & "data", "Continents" 'Add dBASE file to ArcMap AddDBASEFile me & "........" & "data", "Continents" Exit Sub ErrorHandler: MsgBox ption End Sub 1.3.3. 如何连接GeoDataBase文件 本例实现的是连接一个GeoDataBase文件，并在ArcMap中加载该GeoDataBase文件的一个表。 -37- 要点 定义IWorkspaceFactory接口对象，使用AccessWorkspaceFactory类实现之。再创建IFeatureLayer接口对象，用atureClass方法加载GeoDataBase文件的一个表到eClass对象中。最后用er方法将新层添加到当前地图。 使用接口有：IWorkspaceFacktory接口、IFeatureWorkspace接口、IFeatureLayer接口和IMap接口。 程序说明 函数OpenGeoDataBaseFile根据输入的GeoDataBase文件的路径（带文件名及后缀）sAllFileName连接GeoDataBase文件，再根据输入的GeoDataBase文件中的某表表名sTableName加载该表到激活的Map中去。 代码 Private Sub OpenGeoDataBaseFile(ByVal sAllFileName As String, ByVal sTableName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim pFeatureWorkspace As IFeatureWorkspace Dim pFeatureLayer As IFeatureLayer Dim pMxDocument As IMxDocument Dim pMap As IMap Dim sDir As String On Error GoTo ErrorHandler: sDir = Dir(sAllFileName) If (sDir = "") Then MsgBox ("文件不存在") Exit Sub End If 'Create a new AccessWorkspaceFactory object and open a GeoDataBaseFile Set pWorkspaceFactory = New AccessWorkspaceFactory Set pFeatureWorkspace = omFile(sAllFileName, 0) 'Create a new FeatureLayer and assign a Table to it Set pFeatureLayer = New FeatureLayer Set eClass = atureClass(sTableName) = ame 'Add the FeatureLayer to the focus map Set pMxDocument = nt Set pMap = ap er pFeatureLayer Exit Sub ErrorHandler: MsgBox ption End Sub Private Sub UIButtonControl1_Click() Dim pVBProject As VBProject On Error GoTo ErrorHandler: -38- Set pVBProject = ect OpenGeoDataBaseFile me & "........" & "", "arterials" Exit Sub ErrorHandler: MsgBox ption End Sub 1.3.4. 如何连接Coverage文件 本例实现的是如何在当前激活的Map中连接一个Coverage文件。 要点 使用ArcInfoWorkspaceFactory类实现IWorkSpaceFactory接口对象，用方法打开一个Workspace，并获得Dataset对象。由于此时的Dataset对象可能有多个Coverage文件，所以要获得IEnumDataset接口对象，通过方法获得一个Coverage文件，并将其所有的FeatureClass放在IFeatureClassContainer对象中。最后通过方法获得IFeatureClass接口实例，用er方法将要连接的Coverage文件的所有FeatureClass加载到当前激活的Map中。 主要用到IWorkspaceFactory接口，IWorkspace接口，IPropertySet接口，IDataset接口，IEnumDataset接口，IFeatureClassContainer接口。 程序说明 函数ConnectCoverageFile将sFilePath指定的ArcInfo Workspace中的名称和sFileName相同的Coverage文件加载到当前激活的Map中。 代码 Private Sub ConnectCoverageFile(ByVal sFilePath As String, ByVal sFileName As String) Dim pWorkspace As IWorkspace Dim pWorkspaceFactory As IWorkspaceFactory Dim pPropertySet As IPropertySet Dim pDataset As IDataset Dim pEnumDataset As IEnumDataset Dim pFeatureClassC As IFeatureClassContainer Dim pFeatureLayer As IFeatureLayer Dim pMxDocument As IMxDocument Dim pMap As IMap Dim nNumber As Integer Dim sWorkspace As String On Error GoTo ErrorHandler: -39- sWorkspace = Dir(sFilePath, vbDirectory) If (sWorkspace = "") Then MsgBox ("文件不存在") Exit Sub End If Set pWorkspaceFactory = New ArcInfoWorkspaceFactory Set pPropertySet = New PropertySet 'canada is an arcinfoworkspace perty "DATABASE", sFilePath 'pWorkSp is a pointer to the IArcInfoWorkspace Set pWorkspace = (pPropertySet, 0) 'now get to dataset objects using Idataset Set pDataset = pWorkspace 'use enum to get datasets Set pEnumDataset = s 'use FeatureClassContainer to get datasets Set pFeatureClassC = Do While Not pFeatureClassC Is Nothing Set pDataset = pFeatureClassC If ( <> sFileName) Then Set pFeatureClassC = Else Exit Do End If Loop 'add FeatureClassContainer to map If (pFeatureClassC Is Nothing) Then MsgBox ("文件不存在") Else nNumber = 0 Set pMxDocument = ThisDocument Set pMap = ap Do While nNumber < ount Set pFeatureLayer = New FeatureLayer Set eClass = (nNumber) = ame nNumber = nNumber + 1 er pFeatureLayer Loop End If Exit Sub ErrorHandler: MsgBox ption End Sub Private Sub UIButtonControl1_Click() Dim pVBProject As VBProject On Error GoTo ErrorHandler: Set pVBProject = ect ConnectCoverageFile me & "........" & "datacanada", "canada" Exit Sub ErrorHandler: -40- MsgBox ption End Sub 1.3.5. 如何连接栅格文件 本例实现的是如何在当前激活的Map中添加一个栅格文件。 要点 创建一个IrasterLayer接口对象，使用FromFilePath方法加载一个Raster文件，最后用er方法将IRasterLayer添加到当前激活的Map中。 主要用到IRasterLayer接口。 程序说明 函数AddRasterFile将路径sFilePath下的栅格文件sFileName添加到当前激活的Map中。 代码 Private Sub AddRasterFile(sFilePath As String, sFileName As String) 'sFileName: the filename of the raster dataset 'sPath: the directory where the raster dataset resides Dim pRasterLy As IRasterLayer Dim pMxDoc As IMxDocument Dim pMap As IMap Dim sRasterFile As String On Error GoTo ErrorHandler: sRasterFile = Dir(sFilePath & sFileName) If (sRasterFile = "") Then MsgBox ("文件不存在") Exit Sub End If 'Create a raster layer Set pRasterLy = New RasterLayer 'This is only one of the three ways to create a RasterLayer object. 'If there is already a Raster or RasterDataset object, then 'method CreateFromDataset or CreateFromRaster can be used. FromFilePath sFilePath & sFileName 'Add the raster layer to ArcMap Set pMxDoc = ThisDocument Set pMap = ap er pRasterLy h Exit Sub ErrorHandler: MsgBox ption End Sub Private Sub UIButtonControl1_Click() -41- Dim pVBProject As VBProject On Error GoTo ErrorHandler: Set pVBProject = ect AddRasterFile me & "........" & "data", "" Exit Sub ErrorHandler: MsgBox ption End Sub 1.3.6. 如何创建Shape文件 本例实现的是如何创建一个Shape文件。 要点 首先创建新IField接口实例，生成新字段，并获得该实例的IFieldEdit接口对象，用FieldsEdit的AddField方法将新字段加入到IFields接口对象中，最后用IFeatureWorkspace的CreateFeatureClass方法生成新的Shape文件 主要用到IFeatureWorkspace接口，IWorkspaceFactory接口，IFieldsEdit接口，IFieldEdit接口，IFeatureClass接口。 程序说明 函数CreatShapeFile根据输入的文件路径和文件名，创建Shape文件。 代码 Private Sub CreatShapeFile(ByVal sFilePath As String, ByVal sFileName As String) Dim pFeatureWorkspace As IFeatureWorkspace Dim pWorkspaceFactory As IWorkspaceFactory Dim pFields As IFields Dim pFieldsEdit As IFieldsEdit Dim pField As IField Dim pFieldEdit As IFieldEdit Dim pGeometryDef As IGeometryDef Dim pGeometryDefEdit As IGeometryDefEdit Dim pFeatClass As IFeatureClass Dim sShapeFieldName As String Dim sNewShapeFileName As String On Error GoTo ErrorHandler: sNewShapeFileName = Dir(sFilePath & sFileName & ".shp") If (sNewShapeFileName <> "") Then MsgBox ("文件已经存在") Exit Sub End If sShapeFieldName = "Shape" 'Open the folder to contain the shapefile as a workspace Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pFeatureWorkspace = omFile(sFilePath, 0) -42- 'Set up a simple fields collection Set pFields = New Set pFieldsEdit = pFields 'Make the shape field 'it will need a geometry definition, with a spatial reference Set pField = New Set pFieldEdit = pField = sShapeFieldName = esriFieldTypeGeometry Set pGeometryDef = New GeometryDef Set pGeometryDefEdit = pGeometryDef With pGeometryDefEdit .GeometryType = esriGeometryPolygon Set .SpatialReference = New UnknownCoordinateSystem End With Set ryDef = pGeometryDef ld pField 'Add others miscellaneous text field Set pField = New Set pFieldEdit = pField With pFieldEdit .Name = "SmallInteger" .Type = esriFieldTypeSmallInteger End With ld pField Set pField = New Set pFieldEdit = pField With pFieldEdit .Name = "Integer" .Type = esriFieldTypeInteger End With ld pField Set pField = New Set pFieldEdit = pField With pFieldEdit .Name = "Single" .Type = esriFieldTypeSingle End With ld pField Set pField = New Set pFieldEdit = pField With pFieldEdit .Precision = 5 .Scale = 5 .Name = "Double" .Type = esriFieldTypeDouble End With ld pField -43- Set pField = New Set pFieldEdit = pField With pFieldEdit .Length = 30 .Name = "String" .Type = esriFieldTypeString End With ld pField Set pField = New Set pFieldEdit = pField With pFieldEdit .Name = "Date" .Type = esriFieldTypeDate End With ld pField 'Create the shapefile '(some parameters apply to geodatabase options and can be defaulted as Nothing) Set pFeatClass = FeatureClass _ (sFileName, pFields, Nothing, Nothing, _ esriFTSimple, sShapeFieldName, "") sNewShapeFileName = Dir(sFilePath & "") If (sNewShapeFileName = "") Then MsgBox ("Build Success") Else MsgBox ("Build Fail") End If Exit Sub ErrorHandler: MsgBox ption End Sub Private Sub UIButtonControl1_Click() Dim pVBProject As VBProject On Error GoTo ErrorHandler: Set pVBProject = ect 'Dont include .shp extension CreatShapeFile me & "........" & "data", "MyShapeFile" Exit Sub ErrorHandler: MsgBox ption End Sub Private Sub UIButtonControl1_Click() Dim pVBProject As VBProject On Error GoTo ErrorHandler: Set pVBProject = ect 'Dont include .shp extension CreatShapeFile me & "........" & "data", "MyShapeFile" Exit Sub ErrorHandler: -44- MsgBox ption End Sub 1.3.7. 如何创建DBF文件 本例要实现的是如何创建一个单独的DBF文件。 要点 首先设定DBF文件的字段个数，再创建新的IField对象，生成新字段，设置其属性，再加入到IFields对象中，最后用Table方法创建一个新的DBF文件并返回ITable对象。 主要用到IField接口，IFieldEdit接口，IFields接口，IFieldsEdit接口。 程序说明 函数CreateDBF根据输入的路径和文件名创建一个DBF文件并返回一个ITable对象。 代码 Private Function CreateDBF (sFilePath As String, sFileName As String) As ITable 'createDBF: simple function to create a DBASE file. 'note: the name of the DBASE file should not contain the .dbf extension On Error GoTo ErrorHandler: Dim pFeatureWorkspace As IFeatureWorkspace Dim pWorkspaceFactory As IWorkspaceFactory Dim FileFolder As New stemObject Dim pFieldsEdit As sEdit Dim pFieldEdit As Edit Dim pFields As IFields Dim pField As IField Dim sDir As String 'Open the Workspace Set pWorkspaceFactory = New ShapefileWorkspaceFactory If Not Exists(sFilePath) Then MsgBox "路径不存在" & vbCr & sFilePath Exit Function End If sDir = Dir(sFilePath & sFileName & ".dbf") If (sDir <> "") Then MsgBox ("文件已存在") Exit Function End If Set pFeatureWorkspace = omFile(sFilePath, 0) 'if a fields collection is not passed in then create one -45- 'create the fields used by our object Set pFields = New Set pFieldsEdit = pFields ount = 6 'Create text Fields Set pField = New Field Set pFieldEdit = pField With pFieldEdit .Name = "SmallInteger" .Type = esriFieldTypeSmallInteger End With Set (0) = pField Set pField = New Field Set pFieldEdit = pField With pFieldEdit .Name = "Integer" .Type = esriFieldTypeInteger End With Set (1) = pField Set pField = New Field Set pFieldEdit = pField With pFieldEdit .Name = "Single" .Type = esriFieldTypeSingle End With Set (2) = pField Set pField = New Field Set pFieldEdit = pField With pFieldEdit .Precision = 5 .Scale = 5 .Name = "Double" .Type = esriFieldTypeDouble End With Set (3) = pField Set pField = New Field Set pFieldEdit = pField With pFieldEdit .Length = 30 .Name = "String" .Type = esriFieldTypeString End With Set (4) = pField Set pField = New Field Set pFieldEdit = pField With pFieldEdit .Name = "Date" .Type = esriFieldTypeDate End With Set (5) = pField -46- Set createDBF = Table(sFileName, pFields, Nothing, Nothing, "") sDir = Dir(sFilePath & sFileName & ".dbf") If (sDir <> "") Then MsgBox ("Build Success") Else MsgBox ("Build Fail") End If Exit Function ErrorHandler: MsgBox ption End Function Private Sub UIButtonControl1_Click() Dim pVBProject As VBProject Dim pTable As ITable On Error GoTo ErrorHandler: Set pVBProject = ect 'Dont include .dbf extension Set pTable = CreateDBF (me & "........" & "data", "MyDBFFile") Exit Sub ErrorHandler: MsgBox ption End Sub 1.3.8. 如何创建GeoDataBase文件 本例要实现的是如何创建一个GeoDataBase文件。 要点 定义IWorkspaceFactory接口对象，并用esriCore. AccessWorkspaceFactory类来实现，再调用方法创建一个GeoDataBase文件。 主要用到了IWorkspaceFactory接口。 程序说明 函数CreateAccessWorkspace根据要创建的GeoDataBase文件所在路径sFilePath和文件名sFileName创建GeoDataBase文件。 代码 Private Function CreateAccessWorkspace(sFilePath As String, sFileName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim sDir As String -47- On Error GoTo ErrorHandler: sDir = Dir(sFilePath & sFileName & ".mdb") If (sDir <> "") Then MsgBox ("文件已存在") Exit Function End If 'create the Access Workspace factory Set pWorkspaceFactory = New WorkspaceFactory sFilePath, sFileName, Nothing, 0 sDir = Dir(sFilePath & sFileName & ".mdb") If (sDir <> "") Then MsgBox ("Build Success") Else MsgBox ("Build Fail") End If Exit Function ErrorHandler: MsgBox ption End Function Private Sub UIButtonControl1_Click() Dim pVBProject As VBProject On Error GoTo ErrorHandler: Set pVBProject = ect 'Dont include .mdb extension CreateAccessWorkspace me & "........" "MyGEODataFile" Exit Sub ErrorHandler: MsgBox ption End Sub & "data", 1.3.9. 如何创建Coverage文件 本例要实现的是如何创建一个Coverage文件。 要点 首先为IWorkspaceFactory接口创建一个ArcInfoWorkspaceFactory的实例，然后根据路径sWorkspacePath使用方法和方法，获得一个名为sWorkspaceName的ArcInfo Workspace，最后使用IArcInfoWorkspace. CreateCoverage方法创建一个名为sFileName的Coverage文件。 -48- 主要用到IWorkspaceFactory接口，IArcInfoWorkspace接口和IPropertySet接口。 程序说明 函数CreateCoverageFile根据路径sWorkspacePath和名称sWorkspaceName创建一个ArcInfo Workspace，再在其中创建名为sFileName的Coverage文件。 代码 Private Sub CreateCoverageFile(ByVal sWorkspacePath As String, _ ByVal sWorkspaceName As String, ByVal sFileName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim pArcInfoWorkspace As IArcInfoWorkspace Dim pPropertySet As IPropertySet Dim pFeatureDataset As IFeatureDataset Dim sTemplateCoverage As String Dim sCoverageFile As String On Error GoTo ErrorHandler: sCoverageFile = Dir(sWorkspacePath & "" & sWorkspaceName & "" & sFileName, vbDirectory) If (sCoverageFile <> "") Then MsgBox ("文件已经存在") Exit Sub End If Set pFeatureDataset = Nothing Set pPropertySet = New PropertySet perty "SERVER", sWorkspaceName Set pWorkspaceFactory = New ArcInfoWorkspaceFactory 'create an arcinfoworkspace sWorkspacePath, sWorkspaceName, pPropertySet, 0 perty "DATABASE", sWorkspacePath & "" & sWorkspaceName 'pArcInfoWorkspace is a pointer to the IArcInfoWorkspace Set pArcInfoWorkspace = (pPropertySet, 0) 'create a coverage without a template Set pFeatureDataset = Coverage(sFileName, "", _ esriCoveragePrecisionDouble) ' or use the methods on iarcinfoworkspace ' sTemplateCoverage = "C:arcgisarcexe83arcobjects developer kitsamplesdatacanadacanada" ' Set pFeatureDataset = Coverage(sFileName, sTemplateCoverage, _ ' esriCoveragePrecisionDouble) -49-
发布评论