地信开发实习报告_动视

地信开发实习报告

2025-10-02 15:08:46 责编:小OO

点击下载本文 文档为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-2

2、在图 1-1-3 所示的窗口中，用户可以根据实际选择在 Normal 节点或者 Project节点的 ThisDocument、Forms、Modules 中编写宏（函数或过程），Normal 节点下所写的宏系统自动保存，除非用户删除，否则它将始终存在并在任何工程中都有效；而在 Project 节点下所写得宏随工程保存（如不保存工程，则宏也将不被保存），并只在工程中有效。

图 1-1-3

3、运行 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 IMxDocument

Dim pMaps As IMaps

Dim pMap As IMap

Set pMxDocument = Application.Document

Set pMaps = pMxDocument.Maps

If 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_ERROR

Set pMxDocument = Application.Document

Set pMaps = pMxDocument.Maps

Set pMap = pMaps.Item(0)

MsgBox pMap.Name

Exit Sub

SUB_ERROR:

MsgBox "Error: " & Err.Number & "-" & Err.Description

End Sub

结果：

1．无错误

2．有错误

5.实例五

功能：

1.使当前地图的第一图层变为可视（可视的话不变，不可视变为可视）

2.刷新当前视图并刷新视图表

代码：

Public Sub ZDKmacros5()

Dim pMxDocument As IMxDocument

Dim pMap As IMap

Dim pFeatureLayer As IFeatureLayer

Dim pActiveView As IActiveView

Dim pContentsView As IContentsView

Set pMxDocument = ThisDocument

Set pMap = pMxDocument.FocusMap

Set pFeatureLayer = pMap.Layer(0)

If Not pFeatureLayer.Visible Then

pFeatureLayer.Visible = True

End If

Set pActiveView = pMap

pActiveView.Refresh

Set pContentsView = pMxDocument.CurrentContentsView

pContentsView.Refresh pFeatureLayer

End Sub

结果：

1.未使用前

2.使用后

6.实例六

功能：

1. 按NAME 查询要素，查找“shandong”字段。

代码：

Sub ZDKmacros6()

Dim pColor As IRgbColor

Dim pMxdocument As IMxDocument

Set pMxdocument = Application.Document

Dim pMap As IMap

Set 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.Add pFeature

Set 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.Refresh

End Sub

Private Function GetCityFeature(pFeaturelayer As IFeatureLayer, strCityName As String) As IFeature

Dim pFeatureClass As IFeatureClass

Dim pQueryFilter As IQueryFilter

Dim pFeatureCursor As IFeatureCursor

Set pFeatureClass = pFeaturelayer.FeatureClass

Set 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

Else

Set GetCityFeature = pFeature

End If

End Function

Public Function getRGB(ByVal red As Long, ByVal green As Long, ByVal blue As Long) As IColor

Dim pColor As IRgbColor

Set pColor = New RgbColor

pColor.red = red

pColor.blue = blue

pColor.green = green

End Function

结果：

使用前

使用后

7.实例七

功能：

1.放大当前活动地图2倍

2.缩小当前活动地图2倍

代码：

’1放大

Sub ZDKmacros7()

Dim pDoc As IMxDocument

Dim pActiveView As IActiveView

Dim pEnv As IEnvelope

Set pDoc = Application.Document

Set pActiveView = pDoc.ActiveView

Set pEnv = pActiveView.Extent

pEnv.Expand 0.5, 0.5, True '

pActiveView.Extent = pEnv

pActiveView.Refresh

End Sub

’2缩小

Sub ZDKmacros7()

Dim pDoc As IMxDocument

Dim pActiveView As IActiveView

Dim pEnv As IEnvelope

Set pDoc = Application.Document

Set pActiveView = pDoc.ActiveView

Set pEnv = pActiveView.Extent

pEnv.Expand 2, 2, True '

pActiveView.Extent = pEnv

pActiveView.Refresh

End Sub

结果：

1.放大前

放大后

2缩小前

缩小后

8.实例八

功能：

1. 显示全图

代码：

Sub ZDKmacros8()

Dim pDoc As IMxDocument

Dim pActiveView As IActiveView

Set pDoc = Application.Document

Set pActiveView = pDoc.ActiveView

pActiveView.Extent = pDoc.ActiveView.FullExtent

pActiveView.Refresh

End Sub

结果：

使用前

使用后

9．实例九

功能：

1. 清除当前活动图层

代码：

Private Sub ZDKmacros9()

Dim pDoc As IMxDocument

Dim 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.Refresh

End If

End Sub

结果：

使用前

使用后

10.实例十

功能：

1. 查找图层名称等于CHN_adm1的图层

代码：

Sub ZDKmacros10（）

Dim pDoc As IMxDocument

Dim pmap As IMap

Dim name As String

Dim pLayer As ILayer

Set pDoc = Application.Document

Set pmap = pDoc.FocusMap

name = "CHN_adm1"

Set pLayer = FindLayer(pmap, name)

MsgBox pLayer.name

End Sub

Function FindLayer(map As IMap, name As String) As ILayer

Dim i As Integer

For i = 0 To map.LayerCount - 1 '第一层的索引为1

If map.Layer(i).name = name Then '如果第i 层的名称为name

Set FindLayer = map.Layer(i) '获取并返回该层

Exit Function

End If

End 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:\\Arcgis\\country\\CHN_adm", 0) '获取工作空间

Set fc = wks.OpenFeatureClass("CHN_adm0") '获取要素类

Set lyr = New FeatureLayer '创建要素层

Set lyr.FeatureClass = fc '向要素层中添加要素类

Set ds = fc '获取数据集

lyr.name = ds.name '用要素类的名称命名要素层

Set mxDoc = Application.Document '获取当前地图文档

Set map = mxDoc.FocusMap '获取当前地图

map.AddLayer lyr '添加图层

End Sub

结果：

增加前

增加后

12.实例十二

功能：

1. 添加文本，是屏幕显示“Hello”

代码：

Sub ZDKmacros12()

Dim pDoc As IMxDocument

Dim pActiveView As IActiveView

Dim 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 With

End Sub

结果：

13.实例十三

功能：

1.选择要素，显示出城市名称为“Jinan”的城市

代码：

Private Sub ZDKmacors13()

Dim mxDoc As IMxDocument

Dim 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, Nothing

Set selEvents = mxDoc.FocusMap

selEvents.SelectionChanged

End Sub

Function findlayer(pmap As IMap, name As String) As ILayer

Dim i As Integer

For i = 0 To pmap.LayerCount - 1

If pmap.Layer(i).name = name Then

Set findlayer = pmap.Layer(i)

Exit Function

End If

End Function

结果：

14.实例十四

功能：

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 Long

Dim msg As String

Set aCtiveview = pdoc.ActivatedView

Set featureEnum = pdoc.FocusMap.FeatureSelection

featureEnum.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) '显示该要素的Name

Set feat = featureEnum.Next

Loop

End Sub

结果：

15.实例十五

功能：

1.显示图层名称

2.打开新文档

3.关闭现在工作区间

4.输出

代码：

Sub ZDKmacros1()

Dim strName As String

Dim pDoc As IDocument

Dim pBar As IStatusBar

strName = Application.name

MsgBox strName

Dim pApp As IApplication

Set pApp = Application

MsgBox pApp.Caption

pApp.OpenDocument ("E:\\Arcgis\\Zhaidk\\Zhaidk1.mxd")

pApp.Shutdown

Application.Shutdown

Dim pMXapp As IMxApplication

Set pMXapp = pApp

pMXapp.Export

End Sub

结果：

16.实例十六

功能：

1.调整窗口大小

代码：

Sub ZDKmacros2()

Dim pW As IWindowPosition

Set pW = Application

pW.Height = 300

pW.Width = 300

pW.Left = 50

pW.Top = 50

pW.Move 0, 0

End Sub

结果：

使用前

使用后

17.实例十七

功能：

1.交互式工具：创建UIcontrol

2.刷新按钮

代码：

Private Function UIToolControl1_CursorID() As Variant

UIToolControl1_CursorID = 3

End Function

Private 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(pScreenDisp, Nothing)

pDoc.ActivatedView.Extent = pEnv

pDoc.ActivatedView.Refresh

End Sub

结果：

18.实例十八

功能：

代码：

Private Function UIToolControl1_CursorID() As Variant

UIToolControl1_CursorID = 3

End Function

Private 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(pScreenDisp, Nothing)

pDoc.ActivatedView.Extent = pEnv

pDoc.ActivatedView.Refresh

End Sub

结果：

五、收获与建议

通过一周的地信开发课实习，对AO有了进一步的了解，可以一定程度是自主的处理一些开发实例，满足一定的GIS需求；通过代码的输入输出也明白了一个道理“实践出真知”，地信开发是一门严谨的学科，只有通过实时的编程测试考证，才能制作出一个精确完整的开发模块；另外，还明白了效率的重要性，明确的计划和步骤可以大大的节省时间；最后，还有最最重要的一点，保证劳逸结合，身心健康。

建议是：

1）延长实习时间。因为时间太短，对一些操作不能清清楚楚，明明白白的弄懂。

2）提供更加完整的指导教材。有些问题通过现有教材解决。

六、诚信承诺

本人承诺：所有实习成果和实习报告均为本人所做，绝无抄袭。

签名：翟德坤

日期：2011年12月16日

另说明：

1.将一周实习内容按照代码功能描述——关键代码——代码调试结果的格式（附一）填写在word文档中，并附上实习收获与建议。

2.实习报告文件命名为学号+姓名。

3.在实习结束后，将实习报告上交给班长，班长收齐后统一上交给我。下载本文

显示全文

全部频道