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