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

《地理信息系统设计与开发》实验指导书(黑体,小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.实验内容添加地图控件，通过设置地图控件的属性添加数据在窗体上增加一个按钮,双击这个按钮,在代码窗口中输入以下代码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 ThenSet Map1.Extent = Map1.TrackRectangleEnd IfEnd Sub进一步操作PopUp 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 ThenSet Map1.Extent = Map1.TrackRectangleElse: Button = vbRightButtonPopupMenu pop1End IfEnd Sub进一步操作：工具栏ToolBar在窗体上放置ImageList控件设置ImageList1的属性，增加图片ZoomIn.bmp;ZoomOut.bmp;Pan.bmp;Globe.bmp(这些文件在光盘目录BitMaps 下)在窗体上放置ToolBar控件设置ToolBar1的属性，将ToolBar1的图像列表设置为ImageList1;增加按钮ZoomIn,ZoomOut,Pan,设置样式为2-tbrButtonGroup，并设置相应的显示图片；增加第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 控件，并将其名称改为cDlg1，添加一个按钮.程序代码：Private Sub Command1_Click()Dim shpLayer As New MapObjects2.MapLayerDim DC As New MapObjects2.DataConnectionDim gds As MapObjects2.GeoDatasetDim FName As StringcDlg1.Filter = "ESRI Shape文件(*.shp)|*.shp"cDlg1.CancelError = TrueOn Error GoTo eTrapcDlg1.ShowOpenIf Len(cDlg1.FileName) = 0 Then Exit SubDC.Database = CurDirIf Not DC.Connect Then Exit SubFName = Left(cDlg1.FileTitle, Len(cDlg1.FileTitle) - 4) Set gds = DC.FindGeoDataset(FName)If gds Is Nothing Then Exit SubSet shpLayer.GeoDataset = gdsyers.Add shpLayerExit SubeTrap:If Err.Number <> cdlCancel ThenMsgBox Err.Description, vbCriticalEnd IfEnd Sub实验四调整图层顺序1.实验目的掌握在MO当中如何调整图层顺序2.实验内容‘置顶当前图层Private Sub lstLayers_DblClick()Dim lyr As MapObjects2.MapLayerIf lstLayers.ListIndex <> -1 Thenyers.MoveToTop lstLayers.ListIndexMap1.RefreshlstLayers.ClearFor Each lyr In yerslstLayers.AddItem Next lyrEnd IfEnd Sub‘上移图层Private Sub Command2_Click()Dim i As IntegerDim lyr As MapObjects2.MapLayerIf lstLayers.ListIndex <> -1 And lstLayers.ListIndex > 0 Theni = lstLayers.ListIndex - 1yers.MoveTo lstLayers.ListIndex, iMap1.RefreshlstLayers.ClearFor Each lyr In yerslstLayers.AddItem Next lyrlstLayers.Selected(i) = TrueEnd IfEnd Sub‘下移图层Private Sub Command4_Click()Dim i As IntegerDim lyr As MapObjects2.MapLayerIf lstLayers.ListIndex <> -1 And lstLayers.ListIndex < lstLayers.ListCount - 1 Theni = lstLayers.ListIndex + 1yers.MoveTo lstLayers.ListIndex, iMap1.RefreshlstLayers.ClearFor Each lyr In yerslstLayers.AddItem Next lyrlstLayers.Selected(i) = TrueEnd IfEnd Sub实验五取消图层调入和动态跟踪层1.实验目的掌握取消图层调入掌握动态跟踪层的使用2.实验内容‘取消图层调入，运行时设置Map.CancelAction = moCancelMap添加一个command1按钮。

增加事件Command1_Click()。

添加在运行时添加图层的代码添加事件Map1_DrawingCanceled()Private Sub Map1_DrawingCanceled()MsgBox "the layer(or layers) has been canceled!"End Sub‘TrackingLayer动态跟踪Dim pt As New MapObjects2.Point' convert the point to map coordinatesSet pt = Map1.ToMapPoint(X, Y)' add a 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 = moFillSymbol.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, sym1End Sub查看各顶点的M属性地图数据：ynroadsm.shpDim line As New MapObjects2.lineDim recs As New MapObjects2.RecordsetDim recCount As IntegerDim i As IntegerList1.ClearSet recs = yers(0).RecordsrecCount = recs.CountFor i = 0 To recCount - 1List1.AddItem "线段:" & i + 1Set line = recs("Shape").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 partLine.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")End 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 & 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_MouseDown(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 Sub Command1_Click()Dim mycs As New MapObjects2.GeoCoordSysmycs.Type = moGeoCS_Beijing1954Dim mypjcs As New MapObjects2.ProjCoordSysmypjcs.Type = moProjCS_Beijing1954GK_13Set yers(0).CoordinateSystem = mycsSet Map1.CoordinateSystem = mypjcsEnd SubPrivate Sub Map1_MouseDown(Button As Integer, Shift 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 mycorsys As ObjectDim mymaplayer As MapObjects2.MapLayerSet mymaplayer = yers(0)Set mycorsys = mymaplayer.CoordinateSystemIf mycorsys Is Nothing ThenMsgBox "图形为地理坐标系或地图参数未设置"ElseIf mycorsys.IsProjected ThenMsgBox "图形为投影坐标系"Print mymaplayer.CoordinateSystem.TypePrint Print mymaplayer.CoordinateSystem.ReturnDescriptionText1.Text = mymaplayer.CoordinateSystem.ReturnDescription End IfEnd IfEnd Sub2．更改投影添加数据 country 和 world30Private Sub Command1_Click()Dim CSMap As New MapObjects2.ProjCoordSysCSMap.Type = moProjCS_World_WinkelIDim CSMapLayer As New MapObjects2.GeoCoordSysCSMapLayer.Type = moGeoCS_WGS1984Set yers(0).CoordinateSystem = CSMapLayerSet yers(1).CoordinateSystem = CSMapLayerSet Map1.CoordinateSystem = 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 = moProjCS_World_RobinsonSet Map1.CoordinateSystem = CSMapMap1.Extent = Map1.FullExtentEnd Sub3.投影转换，坐标转换第一个图添加数据 country world30 china 第二个图添加数据chinaDim myGT As New MapObjects2.GeoTransformation Dim gcsBJ54 As New MapObjects2.GeoCoordSys Dim myprjBJ54 As New MapObjects2.ProjCoordSys Dim gcsWGS84 As New MapObjects2.GeoCoordSysDim myPt1, myPt2 As New MapObjects2.PointPrivate Sub Form_Load()'begin some pre declearmyprjBJ54.Type = moProjCS_Beijing1954GK_17 gcsBJ54.Type = moGeoCS_Beijing1954gcsWGS84.Type = moGeoCS_WGS1984Set myGT.FromGeoCoordSys = gcsBJ54Set myGT.ToGeoCoordSys = gcsWGS84myGT.Direction = moDirection_Forward = "BJ54_To_WGS1984"myGT.Method = moMethod_PositionVectormyGT.SetParameter moParm_DeltaX, 24myGT.SetParameter moParm_DeltaY, -123myGT.SetParameter moParm_DeltaZ, -94myGT.SetParameter moParm_RotationX, -0.02myGT.SetParameter moParm_RotationY, -0.25myGT.SetParameter moParm_RotationZ, -0.13myGT.SetParameter moParm_DeltaScale, 1'begin map1Set yers(0).CoordinateSystem = gcsWGS84Set yers(1).CoordinateSystem = gcsWGS84Set yers(2).CoordinateSystem = gcsWGS84If Map1.CoordinateSystem Is Nothing ThenSet Map1.CoordinateSystem = gcsWGS84End If'begin map2Set yers(0).CoordinateSystem = gcsWGS84If Map2.CoordinateSystem Is Nothing ThenSet 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.TrackingLayer.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，拷贝china到程序运行目录Private Sub Command1_Click()Dim myrcs As New MapObjects2.RecordsetDim mygeods As New MapObjects2.GeoDatasetDim mydc As New MapObjects2.DataConnection mydc.Database = App.PathPrint App.PathSet mygeods = mydc.FindGeoDataset("china") mygeods.AllowSharing = True'Print '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 = mygeodsyers.Add mymaplyPrint mymaply.Records.Count'Set myrcs = yers(0).Records'yers(0).GeoDataset.AllowSharing = True 'Print yers(0).GeoDataset.HasMeasure Print yers.Item(0).NameEnd Sub2 访问shp文件表格各属性加载数据chinaprjPrivate Sub Command1_Click()Dim myrcs As New MapObjects2.Recordset Set myrcs = yers(0).Records Dim myfld As New MapObjects2.FieldSet myfld = myrcs.Fields("Name")Print myfld.TypePrint Print myfld.ValuePrint myfld.ValueAsStringmyrcs.MoveNextSet myfld = myrcs.Fields("Name")Print myfld.TypePrint Print myfld.ValuePrint myfld.ValueAsStringDim myflds As MapObjects2.FieldsSet myflds = myrcs.FieldsPrint myflds.CountEnd Sub实验十记录集1.实验目的掌握RecordSet的一般用法掌握CalculateStatistics方法创建统计结果2.实验内容查询记录、显示RecordSet记录数目并遍历加载数据chinaprjPrivate Sub Command1_Click()Dim myrcs As New MapObjects2.RecordsetSet myrcs = yers(0).SearchExpression("Area > 2000") Print myrcs.CountIf myrcs Is Nothing ThenPrint "Nothing; there"Elsemyrcs.MoveFirstWhile (Not myrcs.EOF)Print myrcs.Fields("Name").ValueAsStringmyrcs.MoveNextWendDim mystats As MapObjects2.StatisticsSet mystats = myrcs.CalculateStatistics("ObjectID") Print mystats.CountEnd IfEnd Sub实验十一更新表格数据1.实验目的掌握访问Shape文件中表格数据的一般方法掌握如何更新表格数据2.实验内容更新shp文件表格的值加载数据chinaprjPrivate Sub Command1_Click()Dim myarea, sumarea As Doublesumarea = 0Dim myrcs As MapObjects2.RecordsetSet myrcs = yers(0).RecordsIf yers(0).Records.Updatable ThenFor i = 0 To myrcs.Count - 1myarea = myrcs.Fields("shape").Value.Area / 1000000 'myrcs.Edit'myrcs.Fields("Area").Value = myarea'myrcs.Updatemyrcs.MoveNextsumarea = sumarea + myarea'yers(0).SearchExpression (expression)Next iEnd IfPrint sumarea'myrcs.Export "d:\mych"End 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.Parts.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 ptsMap1.TrackingLayer.AddEvent poly, 0Map1.RefreshPrivate Sub Command1_Click()实验十三查找SearchShape1.实验目的掌握SearchShape查找方法的用法了解SearchMethod查找方法的各种常数含义2.实验内容Option ExplicitDim recset1 As MapObjects2.Recordset 'original polygon Dim recset2 As MapObjects2.Recordset 'neighborsPrivate Sub Form_Load()yers(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 = NothingSet recset2 = NothingEnd SubPrivate Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Dim pt As MapObjects2.PointSet pt = Map1.ToMapPoint(X, Y)Set recset1 = yers(0).SearchShape(pt, moPointInPolygon, "")Set recset2 = yers(0).SearchShape(recset1, moCommonPoint, "")Map1.RefreshEnd SubSub DrawSelection(recs As MapObjects2.Recordset, color)' draw the features of a RecordSetDim sym As New MapObjects2.Symbolsym.SymbolType = moFillSymbolsym.Style = moSolidFillsym.color = colorIf Not recs Is Nothing ThenMap1.DrawShape recs, symEnd IfEnd Sub实验十四查找SearchByDistance1.实验目的掌握查找方法SearchByDistance的用法掌握VB和MO中如何确定容错距离2.实验内容Dim myTol As DoubleDim myCircle As ObjectDim resultSym As New MapObjects2.Symbol Dim resultRcs As MapObjects2.Recordset Dim iTargetLy As IntegerPrivate Sub Form_Load()'create list index of each maplayerList1.ClearFor i = 0 To yers.Count - 1List1.AddItem yers(i).NameNextList1.ListIndex = 0'define the symbol of the selected items resultSym.SymbolType = moFillSymbol resultSym.Style = moSolidFill resultSym.Color = moLightYellow'define the default search methodOption1(1).Value = TrueEnd SubPrivate Sub List1_Click()If List1.ListIndex <> -1 Then'Print List1.ListIndexiTargetLy = List1.ListIndexEnd IfEnd SubPrivate Sub Map1_AfterTrackingLayerDraw(ByVal hDC Asstdole.OLE_HANDLE)'drawing searching resultIf Not resultRcs Is Nothing ThenMap1.DrawShape resultRcs, resultSymEnd IfEnd SubPrivate Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = vbRightButton ThenSet myCircle = Map1.TrackCircleElseIf myCircle Is Nothing Then'set the default tolerance to be 3 pixelmyTol = Map1.ToMapDistance(3 * Screen.TwipsPerPixelX)Else'check if the tolerance need to be updatemyTol = myCircle.Width / 2End If'Print myTol'begin polygon searching>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Dim pt As MapObjects2.PointSet pt = Map1.ToMapPoint(X, Y)If Option1(1).Value = True ThenSet resultRcs = yers(iTargetLy).SearchShape(pt, moPointInPolygon, "")ElseSet resultRcs = yers(iTargetLy).SearchByDistance(pt, myTol, "")End If'end polygon searching>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 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 = yers(0).RecordsFor Each pField In pRecset.FieldsList1.AddItem NextWith m_pRenderer.SymbolType = moPointSymbol.Field = "FeatureId"Dim pStats As MapObjects2.StatisticsSet pStats =yers(0).Records.CalculateStatistics("FeatureID") .ValueCount = pStats.CountDim l As LongFor l = 0 To .ValueCount - 1.Symbol(l).SymbolType = moPointSymbol.Symbol(l).Size = 5.Value(l) = lNextEnd WithSet yers(0).Renderer = m_pRendererEnd SubPrivate Sub List1_DblClick()m_pRenderer.ScalingField = List1.List(List1.ListIndex) Map1.RefreshEnd Sub实验十六比例尺1.实验目的掌握MO比例尺控件的用法2.实验内容Option ExplicitPrivate Sub Map1_AfterTrackingLayerDraw(ByVal hDC Asstdole.OLE_HANDLE)'Set the ScaleBar's MapExtent.With ScaleBar1.MapExtent.MinX = Map1.Extent.Left.MinY = Map1.Extent.Bottom.MaxX = Map1.Extent.Right.MaxY = Map1.Extent.Top End With' Set the ScaleBar's PageExtent. 'With ScaleBar1.PageExtent.MinX = Map1.Left / Screen.TwipsPerPixelX.MinY = Map1.Top / Screen.TwipsPerPixelY.MaxX = (Map1.Left + Map1.Width) / Screen.TwipsPerPixelX.MaxY = (Map1.Top + Map1.Height) / Screen.TwipsPerPixelY End With End SubPrivate Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)' Zoom in on the Map.Set Map1.Extent = Map1.TrackRectangleEnd SubPrivate Sub Command1_Click()' Zoom out to FullExtent.Set Map1.Extent = Map1.FullExtentEnd SubPrivate Sub Form_Load()Command1.Caption = "Full Extent"End SubPrivate Sub Form_Resize()ScaleBar1.Move 30, Me.ScaleHeight - 550, Me.ScaleWidth - 120, 495 Command1.Move 30, ScaleBar1.Top - (ScaleBar1.Height + 60), ScaleBar1.Width, ScaleBar1.HeightMap1.Move 30, 30, ScaleBar1.Width, Me.ScaleHeight - (Command1.Height + ScaleBar1.Height + 180)End Sub。