地信开发实习报告.doc

地理信息系统开发与应用实习报告学生姓名 翟德坤 专业年级 09级空间 班级班组 一班 实习日期2011.12.12-2011.12.16指导教师 董 超 山东农业大学ArcGIS二次开发教学实习一、目的意义通过实习使学生进一步理解地理信息系统的开发模式，熟悉ArcGIS二次开发环境，能够自行定制用户界面，对AO中的主要对象模型，包括Map、Element、MapGrid、Style、Symbol和Geodatabase等对象模型简单应用。进一步巩固和深化理论知识，并利用AO中的MapControl控件结合实际案例进行开发，锻炼学生理论与实践相结合的能力。培养学生的应用能力和创新能力，培养学生严肃认真、实事求是、吃苦耐劳、团结协作的精神。要求学生必须参加每一个实习环节，协作完成实习任务，独立完成实习报告。二、实习内容：1、熟悉地理信息系统软件二次开发环境；2、利用地理信息系统软件或开发平台，进行简单的二次开发；3、利用MapControl控件制作相对鹰眼程序。三、时间安排时间任务周一上午实习动员、熟悉开发环境，练习阅读OMD图。周一下午练习VBA开发实例。（见附件AO）周二上午练习VBA开发实例。（见附件AO）周二下午练习课件一、二中的例子。周 三在二次开发环境中，练习第三章：地图是如何组成的实例。熟悉Map等对象模型。周 四练习第五章：AE地图的显示中的实例，熟悉symbol等对象。周 五练习MapControl控件的使用。结合实际，利用MapControl控件制作鹰眼程序。最后总结完成实习报告。四、实习内容及成果（一）熟悉开发环境ArcMap 是 ArcGIS 家族的成员之一，它内置了一种集成编程环境VBA（Visaul Basic for Apllications）。通过 VBA 编程，用户不但可以扩展 ArcMap的菜单、工具条等，而且可以完成大多数用户的特定需求。ArcMap 中 VBA 编程的方法一般步骤如下：写 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 节点下所写的宏系统自动保存，除非用户删除，否则它将始终存在并在任何工程中都有效；而在 Project 节点下所写得宏随工程保存（如不保存工程，则宏也将不被保存），并只在工程中有效。图 1-1-33、运行 VBA 宏 在 VBA 编辑器中写好 VBA 代码后，有两种方式运行：第一，点击 VBA 编辑器工具条中的 （运行）按钮，可立即运行写好的代码；第二，退出 VBA 编辑器，重新启动 Macro 对话框，如图 2，选择要运行的 VBA 宏名称，点击按钮即可运行相应的 VBA 宏。（二）练习VBA开发实例。1.实例一功能： 1.显示当前地图名称代码： Sub ZDKmacros() Dim pMxDocument As IMxDocument Set pMxDocument = Application.Document MsgBox pMxDocument.FocusMap.Name End Sub结果：2.实例二功能： 1.显示地图集中第一幅地图的地图名称代码：Sub ZDKmacros2() Dim pMxDocument As IMxDocumentDim pMaps As IMapsDim pMap As IMapSet pMxDocument = Application.Document Set pMaps = pMxDocument.MapsIf pMaps.Count 1 Set pMap = pMaps.Item(0) MsgBox pMap.Name End If End Sub结果：3.实例三功能： 1.显示当前地图层要素层层数代码：Sub ZDKmacros3() Dim pMxDocument As IMxDocument Dim pMap As IMap Dim lCount As Long Dim lIndex As Long Set pMxDocument = Application.Document Set pMap = pMxDocument.FocusMap lCount = 0 For lIndex = 0 To (pMap.LayerCount - 1) If TypeOf pMap.Layer(lIndex) Is IFeatureLayer Then lCount = lCount + 1 计数器加1 End If Next lIndex MsgBox Number of the feature layers & _ in the active map: & lCount End Sub结果：4.实例四功能： 1. 显示地图集中第一幅地图的地图名称2. 显示错误数和错误信息代码：Sub ZDKmacros4()Dim pMxDocument As IMxDocument Dim pMaps As IMaps Dim pMap As IMap On Error GoTo SUB_ERRORSet pMxDocument = Application.Document Set pMaps = pMxDocument.MapsSet pMap = pMaps.Item(0) MsgBox pMap.Name Exit SubSUB_ERROR:MsgBox Error: & Err.Number & - & Err.Description End Sub结果：1无错误2有错误5.实例五功能： 1. 使当前地图的第一图层变为可视（可视的话不变，不可视变为可视）2. 刷新当前视图并刷新视图表代码：Public Sub ZDKmacros5()Dim pMxDocument As IMxDocumentDim pMap As IMapDim pFeatureLayer As IFeatureLayerDim pActiveView As IActiveViewDim pContentsView As IContentsViewSet pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap Set pFeatureLayer = pMap.Layer(0) If Not pFeatureLayer.Visible ThenpFeatureLayer.Visible = TrueEnd If Set pActiveView = pMap pActiveView.Refresh Set pContentsView = pMxDocument.CurrentContentsViewpContentsView.Refresh pFeatureLayer End Sub结果：1. 未使用前2. 使用后6.实例六功能： 1. 按NAME 查询要素，查找“shandong”字段。代码：Sub ZDKmacros6()Dim pColor As IRgbColorDim pMxdocument As IMxDocumentSet pMxdocument = Application.DocumentDim pMap As IMapSet pMap = pMxdocument.FocusMapDim pFeaturelayer As IFeatureLayerSet pFeaturelayer = pMap.Layer(0)Dim Cityname As StringCityname = ShandongDim pFeature As IFeatureSet pFeature = GetCityFeature(pFeaturelayer, Cityname)Dim pFeatureS As IFeatureSelectionSet pFeatureS = pFeaturelayerpFeatureS.Add pFeatureSet pFeatureS.SelectionColor = getRGB(0, 0, 120) Dim pDoc As IMxDocumentDim pActiveView As IActiveView Set pDoc = Application.Document Set pActiveView = pDoc.activeView pActiveView.Extent = pDoc.activeView.FullExtent pActiveView.Refresh End SubPrivate Function GetCityFeature(pFeaturelayer As IFeatureLayer, strCityName As String) As IFeatureDim pFeatureClass As IFeatureClassDim pQueryFilter As IQueryFilterDim pFeatureCursor As IFeatureCursor Set pFeatureClass = pFeaturelayer.FeatureClassSet pQueryFilter = New QueryFilter pQueryFilter.WhereClause = NAME_1 = & strCityName & Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False)Dim pFeature As IFeature Set pFeature = pFeatureCursor.NextFeature If pFeature Is Nothing Then Set GetCityFeature = Nothing ElseSet GetCityFeature = pFeature End IfEnd FunctionPublic Function getRGB(ByVal red As Long, ByVal green As Long, ByVal blue As Long) As IColor Dim pColor As IRgbColorSet pColor = New RgbColorpColor.red = redpColor.blue = bluepColor.green = greenEnd Function结果：使用前使用后7.实例七功能： 1. 放大当前活动地图2倍2. 缩小当前活动地图2倍代码：1放大Sub ZDKmacros7()Dim pDoc As IMxDocumentDim pActiveView As IActiveView Dim pEnv As IEnvelope Set pDoc = Application.DocumentSet pActiveView = pDoc.ActiveView Set pEnv = pActiveView.ExtentpEnv.Expand 0.5, 0.5, True pActiveView.Extent = pEnvpActiveView.RefreshEnd Sub2缩小Sub ZDKmacros7()Dim pDoc As IMxDocumentDim pActiveView As IActiveView Dim pEnv As IEnvelope Set pDoc = Application.DocumentSet pActiveView = pDoc.ActiveView Set pEnv = pActiveView.ExtentpEnv.Expand 2, 2, True pActiveView.Extent = pEnvpActiveView.RefreshEnd Sub结果：1.放大前放大后2缩小前缩小后8.实例八功能： 1. 显示全图代码：Sub ZDKmacros8()Dim pDoc As IMxDocumentDim pActiveView As IActiveViewSet pDoc = Application.DocumentSet pActiveView = pDoc.ActiveViewpActiveView.Extent = pDoc.ActiveView.FullExtentpActiveView.RefreshEnd Sub结果：使用前使用后9实例九功能： 1. 清除当前活动图层代码：Private Sub ZDKmacros9() Dim pDoc As IMxDocumentDim pActiveView As IActiveView Dim pMap As IMap 地图 Set pDoc = Application.Document Set pActiveView = pDoc.ActiveView If TypeOf pActiveView Is IMap Then Set pMap = pActiveView pMap.ClearLayers pDoc.UpdateContents pActiveView.RefreshEnd If End Sub结果：使用前使用后10.实例十功能： 1. 查找图层名称等于CHN_adm1的图层代码：Sub ZDKmacros10（）Dim pDoc As IMxDocumentDim pmap As IMapDim name As StringDim pLayer As ILayerSet pDoc = Application.DocumentSet pmap = pDoc.FocusMapname = CHN_adm1Set pLayer = FindLayer(pmap, name)MsgBox pLEnd SubFunction FindLayer(map As IMap, name As String) As ILayerDim i As IntegerFor i = 0 To map.LayerCount - 1 第一层的索引为1If map.Layer(i).name = name Then 如果第i 层的名称为nameSet FindLayer = map.Layer(i) 获取并返回该层Exit FunctionEnd IfNextEnd Function结果：11.实例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 IMxDocument 地图文档Dim map As IMap 地图 Set wksFact = New ShapefileWorkspaceFactory 创建Shape 工作空间管理器Set wks = wksFact.OpenFromFile(E:ArcgiscountryCHN_adm, 0) 获取工作空间Set fc = wks.OpenFeatureClass(CHN_adm0) 获取要素类Set lyr = New FeatureLayer 创建要素层Set lyr.FeatureClass = fc 向要素层中添加要素类Set ds = fc 获取数据集 = 用要素类的名称命名要素层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 ITextSymbol Dim bnds As IArea Set pDoc = Application.Document Set pActiveView = pDoc.activeView Set sym = New TextSymbol sym.Font.size = 100 With pActiveView.ScreenDisplay Set bnds = .DisplayTransformation.VisibleBounds .StartDrawing .hDC, esriNoScreenCache.SetSymbol sym .DrawText bnds.Centroid .FinishDrawing End WithEnd Sub结果：13.实例十三功能： 1.选择要素，显示出城市名称为“Jinan”的城市代码：Private Sub ZDKmacors13()Dim mxDoc As IMxDocumentDim lyr As IFeatureLayer Dim sel As IFeatureSelection Dim filter As IQueryFilter Dim selEvents As ISelectionEvents Set mxDoc = Application.Document Set lyr = findlayer(mxDoc.FocusMap, Cities)Set sel = lyr Set filter = New QueryFilter filter.WhereClause = NAME=Jinan sel.SelectFeatures filter, esriSelectionResultNew, False mxDoc.ActiveView.PartialRefresh esriViewGeoSelection, Nothing, NothingSet selEvents = mxDoc.FocusMapselEvents.SelectionChangedEnd SubFunction findlayer(pmap As IMap, name As String) As ILayerDim i As IntegerFor i = 0 To pmap.LayerCount - 1If pmap.Layer(i).name = name ThenSet findlayer = pmap.Layer(i)Exit FunctionEnd IfNextEnd Function结果：14.实例十四功能： 1.显示要素名称代码：Private Sub ZDKmacros14()Dim pdoc As IMxDocumentSet pdoc = ThisDocumentDim aCtiveview As IActiveView Dim featureEnum As IEnumFeatureDim feat As IFeature Dim index As LongDim msg As StringSet aCtiveview = pdoc.ActivatedView Set featureEnum = pdoc.FocusMap.FeatureSelectionfeatureEnum.Reset Set 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 feat = featureEnum.NextLoopEnd Sub结果：15.实例十五功能： 1. 显示图层名称2. 打开新文档3. 关闭现在工作区间4. 输出代码：Sub ZDKmacros1()Dim strName As StringDim pDoc As IDocumentDim pBar As IStatusBarstrName = AMsgBox strNameDim pApp As IApplicationSet pApp = ApplicationMsgBox pApp.CaptionpApp.OpenDocument (E:ArcgisZhaidkZhaidk1.mxd)pApp.ShutdownApplication.ShutdownDim pMXapp As IMxApplicationSet pMXapp = pApppMXapp.ExportEnd Sub结果：16.实例十六功能： 1.调整窗口大小代码：Sub ZDKmacros2()Dim pW As IWindowPositionSet pW = ApplicationpW.Height = 300pW.Width = 300pW.Left = 50pW.Top = 50pW.Move 0, 0End Sub结果：使用前使用后17.实例十七功能： 1. 交互式工具：创建UIcontrol2. 刷新按钮代码：Private Function UIToolControl1_CursorID() As Variant UIToolControl1_CursorID = 3End FunctionPrivate Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long) Dim pDoc As IMxDocument Set pDoc = ThisDocument Dim pScreenDisp As IScreenDisplay Set pScreenDisp = pDoc.ActivatedView.ScreenDisplay Dim pRubber As IRubberBand Dim pEnv As IEnvelope Set pRubber = New RubberEnvelope Set pEnv = pRubber.TrackNew(p