地理信息系统设计与开发实验指导书

1、地理信息系统设计与开发实验指导书(黑体,小3号)课程编号：地理信息系统设计与开发课程英文名称：Design and Development of Geographic Information System学时数： 36 学分数：3适用层次和专业： 地理信息系统及测绘工程本科 实验一 安装MO和VB1.实验目的 学习安装MO学习安装VB6熟悉VB6开发环境2.实验内容安装VB6.0安装MO2.3或更高版本在VB窗体中添加MO组件为MO组件添加数据china.shp实验二 视图缩放和全图操作1.实验目的 掌握MO控件的一般使用方式2.实验内容添加地图控件，通过设置地图控件的属性添加数据在窗体上增加

2、一个按钮,双击这个按钮,在代码窗口中输入以下代码Private Sub Command1_Click() Set Map1.Extent = Map1.FullExtentEnd Sub双击地图控件为他的事件 MouseDown 增加以下代码Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then Set Map1.Extent = Map1.TrackRectangle End IfEnd Sub进一步操作Pop

3、Up Menu(右键菜单)使用菜单编辑器生成一个右键菜单Popup1，为Popup1建立以下几个子菜单项“显示全图”“放大”“缩小”编写代码实现“显示全图”的功能；Private Sub pop1Full_Click() Map1.Extent = Map1.FullExtentEnd Sub修改Mouse事件中的代码，显示右键菜单Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = vbLeftButton Then Set Map1.Exten

4、t = Map1.TrackRectangleElse: Button = vbRightButton PopupMenu pop1 End IfEnd Sub进一步操作：工具栏ToolBar在窗体上放置ImageList控件设置ImageList1的属性，增加图片 ZoomIn.bmp;ZoomOut.bmp;Pan.bmp;Globe.bmp(这些文件在光盘目录BitMaps下)在窗体上放置ToolBar控件设置ToolBar1的属性，将ToolBar1的图像列表设置为ImageList1;增加按钮ZoomIn,ZoomOut,Pan,设置样式为2-tbrButtonGroup，并设置相应

5、的显示图片；增加第4个按钮设置样式为4-tbrPlaceholder;增加第5个按钮btnFullExtent设置图片为Globe.bmp注意：VB控件库 Microsoft Windows Common Controls 6.0 中包含ToolBar 和ImageList控件实验三 动态加载图层1.实验目的 掌握CommandDialog 组件添加图层的方法练习VB中添加按钮的一般方法2.实验内容导入CommandDialog 组件，这一组件在对象库Microsoft Common Dialog Control 6.0 中。添加Map控件，Conmon Dialog 控件，并将其名称改为cD

6、lg1，添加一个按钮.程序代码：Private Sub Command1_Click() Dim shpLayer As New MapObjects2.MapLayer Dim DC As New MapObjects2.DataConnection Dim gds As MapObjects2.GeoDataset Dim FName As String cDlg1.Filter = "ESRI Shape文件(*.shp)|*.shp" cDlg1.CancelError = True On Error GoTo eTrap cDlg1.ShowOpen If Len

7、(cDlg1.FileName) = 0 Then Exit Sub DC.Database = CurDir If Not DC.Connect Then Exit Sub FName = Left(cDlg1.FileTitle, Len(cDlg1.FileTitle) - 4) Set gds = DC.FindGeoDataset(FName) If gds Is Nothing Then Exit Sub Set shpLayer.GeoDataset = gds Map1.Layers.Add shpLayer Exit Sub eTrap: If Err.Number <

8、> cdlCancel Then MsgBox Err.Description, vbCritical End If End Sub实验四 调整图层顺序1.实验目的 掌握在MO当中如何调整图层顺序2.实验内容置顶当前图层Private Sub lstLayers_DblClick() Dim lyr As MapObjects2.MapLayer If lstLayers.ListIndex <> -1 Then Map1.Layers.MoveToTop lstLayers.ListIndex Map1.Refresh lstLayers.Clear For Each ly

9、r In Map1.Layers lstLayers.AddItem lyr.Name Next lyr End IfEnd Sub上移图层Private Sub Command2_Click() Dim i As Integer Dim lyr As MapObjects2.MapLayer If lstLayers.ListIndex <> -1 And lstLayers.ListIndex > 0 Then i = lstLayers.ListIndex - 1 Map1.Layers.MoveTo lstLayers.ListIndex, i Map1.Refres

10、h lstLayers.Clear For Each lyr In Map1.Layers lstLayers.AddItem lyr.Name Next lyr lstLayers.Selected(i) = True End IfEnd Sub下移图层Private Sub Command4_Click() Dim i As Integer Dim lyr As MapObjects2.MapLayer If lstLayers.ListIndex <> -1 And lstLayers.ListIndex < lstLayers.ListCount - 1 Then i

11、 = lstLayers.ListIndex + 1 Map1.Layers.MoveTo lstLayers.ListIndex, i Map1.Refresh lstLayers.Clear For Each lyr In Map1.Layers lstLayers.AddItem lyr.Name Next lyr lstLayers.Selected(i) = True End IfEnd Sub实验五 取消图层调入和动态跟踪层1.实验目的 掌握取消图层调入掌握动态跟踪层的使用2.实验内容取消图层调入，运行时设置Map.CancelAction = moCancelMap添加一个com

12、mand1按钮。增加事件Command1_Click()。添加在运行时添加图层的代码添加事件Map1_DrawingCanceled()Private Sub Map1_DrawingCanceled() MsgBox "the layer(or layers) has been canceled!"End SubTrackingLayer动态跟踪Dim pt As New MapObjects2.Point' convert the point to map coordinatesSet pt = Map1.ToMapPoint(X, Y)' add a

13、new eventMap1.TrackingLayer.AddEvent pt, symIndex实验六 缓冲区1.实验目的 掌握使用缓冲区功能2.实验内容Private Sub Form_Load()Map1.TrackingLayer.SymbolCount = 2With Map1.TrackingLayer.Symbol(0).SymbolType = moPointSymbol.Style = moCircleMarker.Color = moRed.Size = 3End WithWith Map1.TrackingLayer.Symbol(1).SymbolType = moFi

14、llSymbol.Style = moGrayFill.Color = moRed.OutlineColor = moRedEnd WithEnd SubPrivate Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)Dim sym1 As New MapObjects2.Symbolsym1.SymbolType = moFillSymbolsym1.Style = moTransparentFillsym1.OutlineColor = moBlackMap1.DrawShape Map1.FullExtent,

15、 sym1End Sub查看各顶点的M属性地图数据：ynroadsm.shpDim line As New MapObjects2.lineDim recs As New MapObjects2.RecordsetDim recCount As IntegerDim i As IntegerList1.ClearSet recs = Map1.Layers(0).RecordsrecCount = recs.CountFor i = 0 To recCount - 1List1.AddItem "线段:" & i + 1Set line = recs("S

16、hape").ValueoutputMeasures lineNext iPrivate Sub outputMeasures(aLine As MapObjects2.line)Dim itemCount As IntegerDim partLine As MapObjects2.PointsDim i As IntegerFor Each partLine In aLine.PartsFor i = 0 To partLine.Count - 1 Step 1'No of vertices in totalitemCount = itemCount + 1With par

17、tLine.Item(i)List1.AddItem "Item:" & i & "," & itemCount & Chr(9) & "X:" & Format(.X,"#.00") & Chr(9) & "Y:" & Format(.Y, "#.00") & Chr(9) & "M:" & Format(.Measure,"#.00")E

18、nd WithNext iNext partLineEnd Sub实验七 控件坐标和地图坐标1.实验目的 掌握控件坐标和地图坐标转化的一般方法学习地图距离获取的一般方法2.实验内容1. 控件坐标与地图坐标添加数据Chinaprj.shpPrivate Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Form1.RefreshForm1.CurrentX = 0Form1.CurrentY = 200Print "当前鼠标坐标 X：" & X &

19、vbTab & vbTab & "Y: " & YPrintDim pt As MapObjects2.PointSet pt = Map1.ToMapPoint(X, Y)Print "当前地图坐标 X: " & pt.X & vbTab & "Y: " & pt.YPrintPrint Map1.Height & vbTab & vbTab & Map1.WidthEnd Sub2. 控件距离与地图距离Private Sub Map1_MouseDow

20、n(Button As Integer, Shift As Integer, X As Single, Y As Single)Dim mypl As New MapObjects2.LineSet mypl = Map1.TrackLineMap1.TrackingLayer.AddEvent mypl, 0Print "地图距离为:" & mypl.LengthPrint "控件距离为:" & Map1.FromMapDistance(mypl.Length)End Sub3. ProjectionChina.shpPrivate S

21、ub Command1_Click()Dim mycs As New MapObjects2.GeoCoordSysmycs.Type = moGeoCS_Beijing1954Dim mypjcs As New MapObjects2.ProjCoordSysmypjcs.Type = moProjCS_Beijing1954GK_13Set Map1.Layers(0).CoordinateSystem = mycsSet Map1.CoordinateSystem = mypjcsEnd SubPrivate Sub Map1_MouseDown(Button As Integer, S

22、hift As Integer, X As Single, Y As Single)Dim mypt As MapObjects2.PointSet mypt = Map1.ToMapPoint(X, Y)Text1.Text = "X is" & mypt.X & "Y is" & mypt.YEnd Sub实验八 地图投影1.实验目的 掌握如何判断地图是否投影掌握如何更改地图投影2.实验内容判断有没有投影添加数据 china 和 chinaprj 调整顺序观察结果Private Sub Command1_Click()Dim

23、mycorsys As ObjectDim mymaplayer As MapObjects2.MapLayerSet mymaplayer = Map1.Layers(0)Set mycorsys = mymaplayer.CoordinateSystemIf mycorsys Is Nothing Then MsgBox "图形为地理坐标系 或 地图参数未设置"Else If mycorsys.IsProjected Then MsgBox "图形为投影坐标系" End IfEnd IfEnd Sub2更改投影添加数据 country 和 world

24、30Private Sub Command1_Click()Dim CSMap As New MapObjects2.ProjCoordSysCSMap.Type = moProjCS_World_WinkelIDim CSMapLayer As New MapObjects2.GeoCoordSysCSMapLayer.Type = moGeoCS_WGS1984Set Map1.Layers(0).CoordinateSystem = CSMapLayerSet Map1.Layers(1).CoordinateSystem = CSMapLayerSet Map1.CoordinateS

25、ystem = CSMapMap1.Extent = Map1.FullExtentEnd SubPrivate Sub Command2_Click()Dim CSMap As New MapObjects2.GeoCoordSysCSMap.Type = moGeoCS_WGS1984Set Map1.CoordinateSystem = CSMapMap1.Extent = Map1.FullExtentEnd SubPrivate Sub Command3_Click()Dim CSMap As New MapObjects2.ProjCoordSysCSMap.Type = moPr

26、ojCS_World_RobinsonSet Map1.CoordinateSystem = CSMapMap1.Extent = Map1.FullExtentEnd Sub3.投影转换，坐标转换第一个图添加数据 country world30 china 第二个图添加数据chinaDim myGT As New MapObjects2.GeoTransformationDim gcsBJ54 As New MapObjects2.GeoCoordSysDim myprjBJ54 As New MapObjects2.ProjCoordSysDim gcsWGS84 As New MapOb

27、jects2.GeoCoordSysDim myPt1, myPt2 As New MapObjects2.PointPrivate Sub Form_Load()'begin some pre declear myprjBJ54.Type = moProjCS_Beijing1954GK_17 gcsBJ54.Type = moGeoCS_Beijing1954 gcsWGS84.Type = moGeoCS_WGS1984 Set myGT.FromGeoCoordSys = gcsBJ54 Set myGT.ToGeoCoordSys = gcsWGS84 myGT.Direct

28、ion = moDirection_Forward myGT.Name = "BJ54_To_WGS1984" myGT.Method = moMethod_PositionVector myGT.SetParameter moParm_DeltaX, 24 myGT.SetParameter moParm_DeltaY, -123 myGT.SetParameter moParm_DeltaZ, -94 myGT.SetParameter moParm_RotationX, -0.02 myGT.SetParameter moParm_RotationY, -0.25 m

29、yGT.SetParameter moParm_RotationZ, -0.13 myGT.SetParameter moParm_DeltaScale, 1'begin map1Set Map1.Layers(0).CoordinateSystem = gcsWGS84Set Map1.Layers(1).CoordinateSystem = gcsWGS84Set Map1.Layers(2).CoordinateSystem = gcsWGS84If Map1.CoordinateSystem Is Nothing Then Set Map1.CoordinateSystem =

30、 gcsWGS84End If'begin map2Set Map2.Layers(0).CoordinateSystem = gcsWGS84If Map2.CoordinateSystem Is Nothing Then Set Map2.CoordinateSystem = myprjBJ54End IfEnd SubPrivate Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Set myPt1 = Map1.ToMapPoint(X, Y)Map1.Tracki

31、ngLayer.AddEvent myPt1, 0Set myPt2 = Map2.CoordinateSystem.Transform(Map1.CoordinateSystem, myPt1, , myGT)Map2.TrackingLayer.AddEvent myPt2, 0Print myPt1.X & " " myPt1.YPrint myPt2.X & " " myPt2.YEnd Sub实验九 文件状态的查询1.实验目的 掌握文件状态的查询的一般方法2.实验内容1. 显示文件状态、复习动态加载数据加载数据world30，拷

32、贝china到程序运行目录Private Sub Command1_Click()Dim myrcs As New MapObjects2.RecordsetDim mygeods As New MapObjects2.GeoDatasetDim mydc As New MapObjects2.DataConnectionmydc.Database = App.PathPrint App.PathSet mygeods = mydc.FindGeoDataset("china")mygeods.AllowSharing = True'Print mygeods.Na

33、me'Print mygeods.HasMeasure'Print mygeods.HasZ'Print mygeods.AllowSharingPrint mydc.GeoDatasets(0).AllowSharingmydc.GeoDatasets(0).AllowSharing = TruePrint mydc.GeoDatasets(0).AllowSharingDim mymaply As New MapObjects2.MapLayerSet mymaply.GeoDataset = mygeodsMap1.Layers.Add mymaply'S

34、et myrcs = Map1.Layers(0).Records'Map1.Layers(0).GeoDataset.AllowSharing = True'Print Map1.Layers(0).GeoDataset.HasMeasurePrint Map1.Layers.Item(0).NameEnd Sub2 访问shp文件表格各属性加载数据chinaprjPrivate Sub Command1_Click()Dim myrcs As New MapObjects2.RecordsetSet myrcs = Map1.Layers(0).RecordsDim myf

35、ld As New MapObjects2.FieldSet myfld = myrcs.Fields("Name")Print myfld.TypePrint myfld.NamePrint myfld.ValuePrint myfld.ValueAsStringmyrcs.MoveNextSet myfld = myrcs.Fields("Name")Print myfld.TypePrint myfld.NamePrint myfld.ValuePrint myfld.ValueAsStringDim myflds As MapObjects2.F

36、ieldsSet myflds = myrcs.FieldsPrint myflds.CountEnd Sub实验十 记录集1.实验目的 掌握RecordSet的一般用法掌握CalculateStatistics方法创建统计结果2.实验内容查询记录、显示RecordSet记录数目并遍历加载数据chinaprjPrivate Sub Command1_Click()Dim myrcs As New MapObjects2.RecordsetSet myrcs = Map1.Layers(0).SearchExpression("Area > 2000")Print my

37、rcs.CountIf myrcs Is Nothing Then Print "Nothing; there"Else myrcs.MoveFirst While (Not myrcs.EOF) Print myrcs.Fields("Name").ValueAsString myrcs.MoveNext Wend Dim mystats As MapObjects2.Statistics Set mystats = myrcs.CalculateStatistics("ObjectID") Print mystats.CountE

38、nd IfEnd Sub实验十一 更新表格数据1.实验目的 掌握访问Shape文件中表格数据的一般方法掌握如何更新表格数据2.实验内容更新shp文件表格的值加载数据chinaprjPrivate Sub Command1_Click()Dim myarea, sumarea As Doublesumarea = 0Dim myrcs As MapObjects2.RecordsetSet myrcs = Map1.Layers(0).RecordsIf Map1.Layers(0).Records.Updatable Then For i = 0 To myrcs.Count - 1 myar

39、ea = myrcs.Fields("shape").Value.Area / 1000000 'myrcs.Edit 'myrcs.Fields("Area").Value = myarea 'myrcs.Update myrcs.MoveNext sumarea = sumarea + myarea 'Map1.Layers(0).SearchExpression (expression) Next iEnd IfPrint sumarea'myrcs.Export "d:mych"End

40、Sub实验十二 几何要素1.实验目的 掌握点线面等几何要素的用法掌握几何要素点集points和部件parts的构造方法2.实验内容Dim myLine as New MapObjects2.LineDim new_line as New MapObjects2.LineDim pts As New MapObjects2.PointsDim pt As New MapObjects2.Pointpt.X = 100pt.Y = 100pts.Add ptpt.X = 200pt.Y = 200pts.Add ptpt.X = 300pt.Y = 300pts.Add ptnew_line.Pa

41、rts.Add ptsMap1.TrackingLayer.AddEvent new_line, 0Map1.Refresh添加多边形Dim poly As New MapObjects2.PolygonDim pts As New MapObjects2.PointsDim pt As New MapObjects2.Pointpt.X = 100pt.Y = 100pts.Add ptpt.X = 400pt.Y = 100pts.Add ptpt.X = 250pt.Y = 400pts.Add ptpt.X = 100pt.Y = 100pts.Add ptpoly.Parts.Add

42、 ptsMap1.TrackingLayer.AddEvent poly, 0Map1.RefreshPrivate Sub Command1_Click()实验十三 查找SearchShape1.实验目的 掌握SearchShape查找方法的用法了解SearchMethod查找方法的各种常数含义2.实验内容Option ExplicitDim recset1 As MapObjects2.Recordset 'original polygonDim recset2 As MapObjects2.Recordset 'neighborsPrivate Sub Form_Load

43、() Map1.Layers(0).Symbol.color = moPaleYellowEnd SubPrivate Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hDC As stdole.OLE_HANDLE) Call DrawSelection(recset2, moDarkGreen) Call DrawSelection(recset1, moMagenta) Set recset1 = Nothing Set recset2 = NothingEnd SubPri

44、vate Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim pt As MapObjects2.Point Set pt = Map1.ToMapPoint(X, Y) Set recset1 = Map1.Layers(0).SearchShape(pt, moPointInPolygon, "") Set recset2 = Map1.Layers(0).SearchShape(recset1, moCommonPoint, ""

45、) Map1.RefreshEnd SubSub DrawSelection(recs As MapObjects2.Recordset, color) ' draw the features of a RecordSet Dim sym As New MapObjects2.Symbol sym.SymbolType = moFillSymbol sym.Style = moSolidFill sym.color = color If Not recs Is Nothing Then Map1.DrawShape recs, sym End IfEnd Sub实验十四 查找Searc

46、hByDistance1.实验目的 掌握查找方法SearchByDistance的用法掌握VB和MO中如何确定容错距离2.实验内容Dim myTol As DoubleDim myCircle As ObjectDim resultSym As New MapObjects2.SymbolDim resultRcs As MapObjects2.RecordsetDim iTargetLy As IntegerPrivate Sub Form_Load()'create list index of each maplayerList1.ClearFor i = 0 To Map1.La

47、yers.Count - 1List1.AddItem Map1.Layers(i).NameNextList1.ListIndex = 0'define the symbol of the selected itemsresultSym.SymbolType = moFillSymbolresultSym.Style = moSolidFillresultSym.Color = moLightYellow'define the default search methodOption1(1).Value = TrueEnd SubPrivate Sub List1_Click(

48、)If List1.ListIndex <> -1 Then'Print List1.ListIndexiTargetLy = List1.ListIndexEnd IfEnd SubPrivate Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)'drawing searching resultIf Not resultRcs Is Nothing Then Map1.DrawShape resultRcs, resultSymEnd IfEnd SubPrivate Sub Map1_

49、MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = vbRightButton Then Set myCircle = Map1.TrackCircleElse If myCircle Is Nothing Then 'set the default tolerance to be 3 pixel myTol = Map1.ToMapDistance(3 * Screen.TwipsPerPixelX) Else 'check if the tolerance n

50、eed to be update myTol = myCircle.Width / 2 End If 'Print myTol 'begin polygon searching>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Dim pt As MapObjects2.Point Set pt = Map1.ToMapPoint(X, Y)

51、If Option1(1).Value = True Then Set resultRcs = Map1.Layers(iTargetLy).SearchShape(pt, moPointInPolygon, "") Else Set resultRcs = Map1.Layers(iTargetLy).SearchByDistance(pt, myTol, "") End If 'end polygon searching>>>>>>>>>>>>>>>&g

52、t;>>>>>>>>>>>>>>>>>>>>>>> Map1.RefreshEnd IfEnd Sub实验十五 渲染1.实验目的 掌握MO中图形渲染的一般方法掌握ValueMapRenderer、DotDensityRenderer等渲染的基本用法2.实验内容Option ExplicitPrivate m_pRenderer As New MapObjects2.ValueMapRendererPrivate Sub Form_Load() Dim pRecset As MapObjects2.Recordset, pField As MapObjects2.Field Set pRecset = Map1.Layers(0).Records For Each pField In pRec