地信开发实习报告

1、地信开发实习报告地理信息系统开发与应用实习报告学生姓名 翟德坤专业年级 09 级空间班级班组一班实习日期 2011.12.12-2011.12.16指导教师董 超山东农业大学 ArcGIS 二次开发教学实习一、目的意义 通过实习使学生进一步理解地理信息系统 的开发模式，熟悉 ArcGIS 二次开发环境，能够 自行定制用户界面，对 AO中的主要对象模型， 包括 Map、Element 、 MapGrid、 Style 、Symbol 和 Geodatabase 等对象模型简单应用。进一步 巩 固 和 深 化 理 论 知 识 ， 并 利 用 AO 中 的 MapControl 控件结合实际案例进行

2、开发，锻炼 学生理论与实践相结合的能力。培养学生的应 用能力和创新能力，培养学生严肃认真、实事 求是、吃苦耐劳、团结协作的精神。要求学生 必须参加每一个实习环节， 协作完成实习任务， 独立完成实习报告。二、实习内容：1、熟悉地理信息系统软件二次开发环境；2、利用地理信息系统软件或开发平台，进 行简单的二次开发；3、利用 MapControl 控件制作相对鹰眼程序三、时间安排时 间任务周一上 午实习动员、熟悉开发环境，练习阅读 OMD图。周一下 午练习 VBA开发实例。（见附件 AO）周二上 午练习 VBA开发实例。（见附件 AO）周二下 午练习课件一、二中的例子。周在二次开发环境中，练习第三章

3、：地 图是如何组成的实例。熟悉 Map等对 象模型。周四练习第五章：AE地图的显示中的实例， 熟悉 symbol 等对象。周五练习 MapControl 控件的使用。 结合实 际，利用 MapControl 控件制作鹰眼程 序。最后总结完成实习报告。四、实习内容及成果（一）熟悉开发环境ArcMap 是 ArcGIS 家族的成员之一，它内 置了一种集成编程环境 VBA（ Visaul Basic for Apllications ）。通过 VBA 编程，用户不 但可以扩展 ArcMap 的菜单、工具条等， 而且可 以完成大多数用户的特定需求。 ArcMap 中 VBA 编程的方法一般步骤如下：

4、写 VBA 宏（直接在 VBA 编辑器中编辑函数和 过程）1、如图 1-1-1 ，单击菜单栏中的 命令 , 选择 的 项, 直接启动 ArcMap 的 VBA 编辑器； 或者选 择 的项，进入如图 1-1-2 所 示 Macro 对话框，在“ Macro Name”文本框中 输入要创建的宏的名称，并点 按钮， 启动 VBA 编辑器。图 1-1-1图 1-1-22、在图 1-1-3 所示的窗口中， 用户可以根据实际选择在 Normal 节点或者 Project 节点的 ThisDocument 、 Forms、 Modules 中编写宏 （函数或过程） ，Normal 节点下所写的宏系统自动保存

5、，除非用户删除，否则它将始终存在 并在任何工程中都有效； 而在 Project 节点下 所写得宏随工程保存（如不保存工程，则宏也 将不被保存），并只在工程中有效。图 1-1-33、运行 VBA 宏 在 VBA 编辑器中写好 VBA 代码后，有两种方式运行：第一，点击 VBA 编 辑器工具条中的 （运行）按钮，可立即运行写 好的代码；第二，退出 VBA 编辑器，重新启动 Macro 对话框，如图 2 ，选择要运行的 VBA 宏 名称，点击 按钮即可运行相应的 VBA 宏。(二)练习 VBA 开发实例。1. 实例一功能：1. 显示当前地图名称代码：Sub ZDKmacros()Dim pMxDoc

6、ument As IMxDocumentSet pMxDocument = Application.DocumentMsgBox pMxDocument.FocusMap.NameEnd Sub结果：2. 实例二功能：1. 显示地图集中第一幅地图的地图名称 代码：Sub ZDKmacros2()Dim pMxDocument As IMxDocument Dim pMaps As IMapsDim pMap As IMapSet pMxDocument =Application.DocumentSet pMaps = pMxDocument.MapsIf pMaps.Count 1Set pM

7、ap = pMaps.Item(0) MsgBox pMap.NameEnd IfEnd Sub3. 实例三 功能：1.显示当前地图层要素层层数代码：Sub ZDKmacros3()Dim pMxDocument As IMxDocumentDim pMap As IMapDim lCount As LongDim lIndex As LongSet pMxDocument = Application.DocumentSet pMap = pMxDocument.FocusMap lCount = 0For lIndex = 0 To (pMap.LayerCount - 1)If TypeO

8、f pMap.Layer(lIndex) Is IFeatureLayer ThenlCount = lCount + 1 计数器加 1 End If Next lIndexMsgBox Number of the feature layers & in the active map: & lCount End Sub4. 实例四 功能：1.显示地图集中第一幅地图的地图名称2. 显示错误数和错误信息 代码：Sub ZDKmacros4()Dim pMxDocument As IMxDocument Dim pMaps As IMapsDim pMap As IMapOn Error GoTo

9、SUB_ERRORSet pMxDocument =Application.DocumentSet pMaps = pMxDocument.MapsSet pMap = pMaps.Item(0)MsgBox pMap.NameExit SubSUB_ERROR:MsgBox Error: & Err.Number & -& Err.DescriptionEnd Sub1无错误2有错误5. 实例五 功能：1.使当前地图的第一图层变为可视（可视的话不变，不可视变为可视)2. 刷新当前视图并刷新视图表 代码：Public Sub ZDKmacros5()Dim pMxDocument As IMx

10、DocumentDim pMap As IMapDim pFeatureLayer As IFeatureLayer Dim pActiveView As IActiveViewDim pContentsView As IContentsViewSet pMxDocument = ThisDocumentSet pMap = pMxDocument.FocusMapSet pFeatureLayer = pMap.Layer(0)If Not pFeatureLayer.Visible Then pFeatureLayer.Visible = True End IfSet pActiveVie

11、w = pMappActiveView.RefreshSet pContentsView =pMxDocument.CurrentContentsViewpContentsView.Refresh pFeatureLayerEnd Sub结果：1. 未使用前2. 使用后6. 实例六 功能：1. 按 NAME 查询要素，查找“ shandong” 字段。代码：Sub ZDKmacros6()Dim pColor As IRgbColorDim pMxdocument As IMxDocumentSet pMxdocument = Application.DocumentDim pMap As I

12、MapSet pMap = pMxdocument.FocusMap Dim pFeaturelayer As IFeatureLayer Set pFeaturelayer = pMap.Layer(0) Dim Cityname As String Cityname = Shandong Dim pFeature As IFeature Set pFeature = GetCityFeature(pFeaturelayer, Cityname)Dim pFeatureS As IFeatureSelection Set pFeatureS = pFeaturelayer pFeatureS

13、.Add pFeatureSet pFeatureS.SelectionColor = getRGB(0, 0, 120)Dim pDoc As IMxDocument Dim pActiveView As IActiveView Set pDoc = Application.Document Set pActiveView = pDoc.activeView pActiveView.Extent =pDoc.activeView.FullExtent pActiveView.RefreshEnd SubPrivate FunctionGetCityFeature(pFeaturelayer

14、AsIFeatureLayer, strCityName As String) As IFeatureDim pFeatureClass As IFeatureClassDim pQueryFilter As IQueryFilterDim pFeatureCursor As IFeatureCursorSet pFeatureClass = pFeaturelayer.FeatureClassSet pQueryFilter = New QueryFilter pQueryFilter.WhereClause = NAME_1 = & strCityName & Set pFeatureCu

15、rsor =pFeatureClass.Search(pQueryFilter, False)Dim pFeature As IFeatureSet pFeature = pFeatureCursor.NextFeatureIf pFeature Is Nothing ThenSet GetCityFeature = NothingElseSet GetCityFeature = pFeatureEnd IfEnd FunctionPublic Function getRGB(ByVal red As Long, ByVal green As Long, ByVal blue As Long)

16、 As IColorDim pColor As IRgbColorSet pColor = New RgbColor pColor.red = redpColor.blue = blue pColor.green = greenEnd Function结果：使用前使用后7. 实例七 功能：1.放大当前活动地图 2 倍2.缩小当前活动地图 2 倍 代码：1 放大Sub ZDKmacros7()Dim pDoc As IMxDocumentDim pActiveView As IActiveViewDim pEnv As IEnvelopeSet pDoc = Application.Docume

17、nt Set pActiveView = pDoc.ActiveViewSet pEnv = pActiveView.Extent pEnv.Expand 0.5, 0.5, True pActiveView.Extent = pEnv pActiveView.Refresh End Sub2 缩小Sub ZDKmacros7()Dim pDoc As IMxDocumentDim pActiveView As IActiveView Dim pEnv As IEnvelopeSet pDoc = Application.Document Set pActiveView = pDoc.Acti

18、veViewSet pEnv = pActiveView.Extent pEnv.Expand 2, 2, True pActiveView.Extent = pEnv pActiveView.Refresh End Sub结果：1. 放大前放大后商 r-O JJj. 3 bl LDOuQgepg ：Pim书 | 呵*町x.mij应 BLpaigi血“i霉 h*叱空型巴mgxLp| 4 rijKIJ.41 |i JV F iJaKlHY - IP I exi缩小后8. 实例八 功能：1. 显示全图 代码：Sub ZDKmacros8()Dim pDoc As IMxDocumentDim pA

19、ctiveView As IActiveView Set pDoc = Application.Document Set pActiveView = pDoc.ActiveView pActiveView.Extent =pDoc.ActiveView.FullExtentpActiveView.RefreshEnd Sub使用前使用后9实例九 功能：1. 清除当前活动图层 代码：Private Sub ZDKmacros9()Dim pDoc As IMxDocumentDim pActiveView As IActiveView Dim pMap As IMap 地图Set pDoc =

20、Application.DocumentSet pActiveView = pDoc.ActiveViewIf TypeOf pActiveView Is IMap Then Set pMap = pActiveView pMap.ClearLayers pDoc.UpdateContents pActiveView.RefreshEnd IfEnd Sub结果：使用前使用后10. 实例十功能：1. 查找图层名称等于 CHN_adm1 的图层 代码：Sub ZDKmacros10 ()Dim pDoc As IMxDocumentDim pmap As IMapDim name As Stri

21、ngDim pLayer As ILayerSet pDoc = Application.DocumentSet pmap = pDoc.FocusMap name = CHN_adm1Set pLayer = FindLayer(pmap, name)MsgBox pLEnd SubFunction FindLayer(map As IMap, nameAs String) As ILayerDim i As IntegerFor i = 0 To map.LayerCount - 1 第一层 的索引为 1If map.Layer(i).name = name Then 如

22、果第 i 层的名称为 nameSet FindLayer = map.Layer(i) 获取并返回 该层Exit FunctionEnd If NextEnd Function11. 实例 11 功能：1. 添加图层代码：Sub ZDKmacros11()Dim wksFact As IWorkspaceFactory 工作 空间管理器Dim wks As IFeatureWorkspace 要素工作 空间Dim fc As IFeatureClass 要素类Dim lyr As IFeatureLayer 要素层Dim ds As IDataset 数据集Dim mxDoc As IMxDo

23、cument 地图文档Dim map As IMap 地图Set wksFact = NewShapefileWorkspaceFactory 创建 Shape 工作 空间管理器Set wks = wksFact.OpenFromFile(E:ArcgiscountryC HN_adm, 0) 获取工作空间Set fc =wks.OpenFeatureClass(CHN_adm0) 获取要 素类Set lyr = New FeatureLayer 创建要素层Set lyr.FeatureClass = fc 向要素层中添加 要素类Set ds = fc 获取数据集 = ds.n

24、ame 用要素类的名称命名 要素层Set mxDoc = Application.Document 获取 当前地图文档Set map = mxDoc.FocusMap 获取当前地 图map.AddLayer lyr 添加图层End Sub增加前增加后12.实例十二功能：1. 添加文本，是屏幕显示“ Hello ” 代码：Sub ZDKmacros12()Dim pDoc As IMxDocumentDim pActiveView As IActiveViewDim sym As ITextSymbolDim bnds As IAreaSet pDoc = Application.Documen

25、t Set pActiveView = pDoc.activeViewSet sym = New TextSymbol sym.Font.size = 100With pActiveView.ScreenDisplaySet bnds= .DisplayTransformation.VisibleBounds .StartDrawing .hDC, esriNoScreenCache .SetSymbol sym.DrawText bnds.Centroid.FinishDrawingEnd WithEnd Sub13.实例十三功能：1.选择要素，显示出城市名称为“ Jinan 的城市结果：代

26、码：Private Sub ZDKmacors13()Dim mxDoc As IMxDocumentDim lyr As IFeatureLayerDim sel As IFeatureSelectionDim filter As IQueryFilterDim selEvents As ISelectionEventsSet mxDoc = Application.DocumentSet lyr = findlayer(mxDoc.FocusMap, Cities)Set sel = lyrSet filter = New QueryFilter filter.WhereClause =

27、NAME=Jinan sel.SelectFeatures filter, esriSelectionResultNew, FalsemxDoc.ActiveView.PartialRefresh esriViewGeoSelection, Nothing, NothingSet selEvents = mxDoc.FocusMap selEvents.SelectionChangedEnd SubFunction findlayer(pmap As IMap, nameAs String) As ILayerDim i As IntegerFor i = 0 To pmap.LayerCou

28、nt - 1If pmap.Layer(i).name = name Then Set findlayer = pmap.Layer(i)Exit FunctionEnd IfNextEnd Function14. 实例十四 功能：1.显示要素名称 代码：Private Sub ZDKmacros14() Dim pdoc As IMxDocument Set pdoc = ThisDocument Dim aCtiveview As IActiveView Dim featureEnum As IEnumFeature Dim feat As IFeature Dim index As Lo

29、ng Dim msg As StringSet aCtiveview = pdoc.ActivatedView Set featureEnum = pdoc.FocusMap.FeatureSelection featureEnum.ResetSet feat = featureEnum.Next Do While Not feat Is Nothing index = feat.Fields.FindField(NAME) If index -1 Then MsgBox msg &Chr(13) & Chr(10) & feat.Value(index) 显示该 要素的 NameSet fe

30、at = featureEnum.NextLoopEnd Sub结果：15. 实例十五 功能：1.显示图层名称2.打开新文档3. 关闭现在工作区间4. 输出 代码：Sub ZDKmacros1()Dim strName As StringDim pDoc As IDocument Dim pBar As IStatusBar strName = A MsgBox strNameDim pApp As IApplication Set pApp = Application MsgBox pApp.CaptionpApp.OpenDocument (E:ArcgisZhaidkZhaidk1.mxd)pApp.ShutdownApplication.ShutdownDim pMXapp As IMxApplication Set pMXapp = pApp pMXapp.ExportEnd Sub结果：16. 实例十六 功能：1.调整窗口大小 代码：Sub ZDKmacros2()Dim pW As IWindowPositi