mapbasic程序有詳細(xì)的解釋

1、精品文檔河道比降計(jì)算程序mapinfo=' 項(xiàng)目：河道比降計(jì)算' 作者：崔軍明' 版本： 2.2' 日期： 2009-12-23'' 使用說(shuō)明：' 1 、新建圖層，繪制主河道（也可以復(fù)制水系，然后整理出主河道）。' 2 、確定高程的單位（米 / 分米）。如果與主河道相交的等高線的高程單位不統(tǒng)一，則將其修改一致。' 3 、運(yùn)行此程序，打開(kāi)需要的表，設(shè)置計(jì)算選項(xiàng)，計(jì)算河道比降。' 4 、如果遇到錯(cuò)誤， 根據(jù)提示將河道上的節(jié)點(diǎn)吸附在等高線上， 并保存河道表 (Stream) 。'關(guān)閉全部表（不必保存），重新運(yùn)行程

2、序。'5 、程序運(yùn)行結(jié)束后，保存計(jì)算結(jié)果，然后瀏覽比降計(jì)算表(Gradient)。'(1)復(fù)查高程列 (Elev) 的單位是否統(tǒng)一，確認(rèn)設(shè)置計(jì)算選項(xiàng)時(shí)所作的選擇是正確的。' 6 、注意，計(jì)算某個(gè)流域的河道比降時(shí)， 只需打開(kāi)對(duì)應(yīng)部分的等高線圖層。如果等高線圖層太大，會(huì)大大影響計(jì)算速度。'='-'MapBasic 的調(diào)試方法：' (1)在出錯(cuò)或需要的地方，使用Note（或 Print ）語(yǔ)句將變量的值顯示出來(lái)。' (2) 在 MapInfo 中，打開(kāi) MapBasic 窗口，回車就會(huì)執(zhí)行當(dāng)前語(yǔ)句。''MapBasic

3、中 SQL的特性：' (1) Delete 語(yǔ)句，執(zhí)行的是無(wú)條件刪除，即刪除表中的全部記錄。它不像SQLServer 的 SQL語(yǔ)句，可以加Where限制從句。'它的 Where Rowid = ?子句用處不大！' (2) Update 語(yǔ)句，執(zhí)行的也是無(wú)條件更新，默認(rèn)情況下，它會(huì)更新全部記錄。但是， Update 語(yǔ)句可以通過(guò)視圖更新，這就'等價(jià)于使用了 Where子句。如： Select * From Table Where column= ? , Update Selection Set Column = Value，'參考 MapBasic 幫助

4、。'-Include "MAPBASIC.DEF"Declare Sub MainDeclare Sub OpenTable.精品文檔Declare Sub InitDeclare Sub SetupCalcOptionDeclare Sub WriteElev2GradientDeclare Sub AddCrossingOnStreamDeclare Sub GetReachLenDeclare Sub WriteLen2GradientDeclare Function IsDownStream As LogicalDeclare Function Locate

5、Crossing(L As Object, Li As Object, ByVal C AsInteger) As IntegerDeclare Function CalcGradient As FloatDeclare Sub SaveGradient(ByVal J As Float)Global EVAs Integer'等高線的高程， 用來(lái)查詢當(dāng)前正在處理的等高線，便于找到?jīng)]有吸附的等高線Global ELEV_UNITS As Integer '高程單位選項(xiàng)值'-' 計(jì)算河道比降'-Sub MainDim J As Float'河道比降

6、Call OpenTable'打開(kāi)相關(guān)表Call Init' 初始化Call SetupCalcOption'設(shè)置計(jì)算選項(xiàng)Call WriteElev2Gradient '查詢和河道相交的等高線并將其寫(xiě)入比降計(jì)算表Call AddCrossingOnStream '在河道上添加交點(diǎn)節(jié)點(diǎn)Call GetReachLen' 獲取河段長(zhǎng)度，并將其存入河段長(zhǎng)度臨時(shí)表Call WriteLen2Gradient'將河段長(zhǎng)度導(dǎo)入比降計(jì)算表中J = CalcGradient()'計(jì)算河道比降Call SaveGradient(J)'保存

7、計(jì)算結(jié)果End Sub'-' 打開(kāi)河道、等高線和比降計(jì)算表'-Sub OpenTableDim StreamFileName As StringDim ContourFileName As StringDim GradientFileName As String' 彈出對(duì)話框，打開(kāi)相關(guān)表StreamFileName = FileOpenDlg("", "", "TAB", "打開(kāi)主河道 ")ContourFileName = FileOpenDlg("", &qu

8、ot;", "TAB", "打開(kāi)等高線 ")GradientFileName = FileOpenDlg("", "", "TAB", "打開(kāi)比降計(jì)算表 ")Open Table StreamFileName As Stream.精品文檔Open Table ContourFileName As ContourOpen Table GradientFileName As GradientEnd Sub'-' 初始化'-Sub Init'

9、;Dim MapWinId As Integer' 地圖窗口 ID'Dim MapCoordSys As String' 地圖坐標(biāo)系（投影）' 設(shè)置坐標(biāo)系（投影）'Map From Stream 'MapWinId = FrontWindow()'MapCoordSys = MapperInfo(MapWinId, MAPPER_INFO_COORDSYS_CLAUSE) 'Set CoordSys Earth' Projection MapCoordSys'Close Window MapWinId' 設(shè)

10、置長(zhǎng)度單位為米Set Distance Units "m"' 創(chuàng)建河段長(zhǎng)度臨時(shí)表Create Table ReachLen (Length Float)Open Table ReachLenEnd Sub'-' 設(shè)置計(jì)算選項(xiàng)'-Sub SetupCalcOption' 定義了河道起點(diǎn)和高程單位兩個(gè)選項(xiàng)DialogTitle "計(jì)算選項(xiàng) "Control StaticTextTitle "高程單位： "Control RadioGroupTitle "米; 分米 "Into E

11、LEV_UNITSControl OKButtonTitle "確定 "Control CancelButtonTitle "取消 "' 如果取消設(shè)置或關(guān)閉了設(shè)置窗口，則退出程序If Not CommandInfo(CMD_INFO_DLG_OK) Then.精品文檔Drop Table ReachLenClose Table StreamClose Table ContourClose Table GradientEnd ProgramEnd IfEnd Sub'-' 查詢和河道相交的等高線并將其插入比降計(jì)算表中'-Su

12、b WriteElev2GradientDim E As Integer' 高程Dim oLine As Object '等高線對(duì)象' 清空河段表中的記錄Delete From Gradient' 查詢和主河道相交的等高線Select contour.Elev, contour.Obj From contour, StreamWhere contour.Obj Intersects Stream.ObjOrder By contour.Elev DESCInto Intersection' 將高程值和等高線對(duì)象都寫(xiě)入比降計(jì)算表中Fetch First F

13、rom Intersection Do While Not EOT(Intersection)E = Intersection.Elev oLine = Intersection.ObjInsert Into Gradient (Elev, Obj) Values (E, oLine) Fetch Next From IntersectionLoop' 保存比降計(jì)算表Commit Table GradientEnd Sub'-' 在河道上添加和等高線的交點(diǎn)節(jié)點(diǎn)' OverlayNodes() 函數(shù)返回添加了交點(diǎn)的折線對(duì)象（但是該函數(shù)有誤差，有時(shí)添加的節(jié)點(diǎn)不能完全

14、吸附）'-Sub AddCrossingOnStreamDim S As Object '河道折線對(duì)象Dim C As Object '與河道相交的等高線對(duì)象Dim E As Integer '高程值，作為更新等高線的條件.精品文檔' 在河道和等高線上添加相交節(jié)點(diǎn)Fetch First From GradientDo While Not EOT(Gradient)' 在河道上添加相交節(jié)點(diǎn)S = OverlayNodes(Stream.Obj, Gradient.Obj) 'Update Stream Set Obj = S' 在等

15、高線上也添加一個(gè)相交節(jié)點(diǎn)C = OverlayNodes(Gradient.Obj, Stream.Obj)E = Gradient.ElevSelect * From Gradient Where Elev = EUpdate Selection Set Obj = CFetch Next From GradientLoopEnd Sub'-' 獲取河段長(zhǎng)度，并將其存入河段長(zhǎng)度臨時(shí)表中' 關(guān)于 ExtractNodes() 函數(shù)的說(shuō)明： begin_node 要小于 end_node '-Sub GetReachLenDim S As Object'

16、河道Dim N As Integer' 河道上的節(jié)點(diǎn)數(shù)Dim I, C As Integer '循環(huán)控制變量Dim Line1 As Object '等高線 1Dim Line2 As Object '等高線 2Dim B, E As Integer '河段的首尾節(jié)點(diǎn)序號(hào)Dim R As Object' 河段對(duì)象Dim L As Float' 河段長(zhǎng)度' 清空河段長(zhǎng)度表Delete From ReachLen' 獲取河道對(duì)象及其節(jié)點(diǎn)數(shù)Fetch First From Stream S = Stream.ObjN = Obj

17、ectInfo(S, OBJ_INFO_NPNTS)' 統(tǒng)計(jì)等高線條數(shù)，控制循環(huán)Select Count(*) From GradientC = Selection.Col1' 河道起點(diǎn)位置不同，計(jì)算河段長(zhǎng)度時(shí)的起止順序就不同Dim IsDown As Logical' 是否順流而下IsDown = IsDownStream()If IsDown Then' 如果河道起點(diǎn)從源頭開(kāi)始' 計(jì)算河段長(zhǎng)度并將其插入河段長(zhǎng)度表Fetch First From Gradient.精品文檔EV = Gradient.Elev' 用來(lái)尋找沒(méi)有吸附的等高線Line

18、1 = Gradient.Obj' 第一條等高線對(duì)象E = LocateCrossing(S, Line1, N)' 河道與第一條等高線的交點(diǎn)位置For I = 1 To C - 1B=E' 首節(jié)點(diǎn)序號(hào)Fetch Next From GradientEV = Gradient.Elev' 用來(lái)尋找沒(méi)有吸附的等高線Line2 = Gradient.Obj' 下一條等高線E = LocateCrossing(S, Line2, N)' 尾節(jié)點(diǎn)序號(hào)，河道與下一條等高線的交點(diǎn)位置R = ExtractNodes(S, 1, B, E, FALSE)

19、9; 抽取河段，按 B -> EL = ObjectLen(R, "m")' 獲取河段長(zhǎng)度Insert Into ReachLen (Length) Values (L) '將河段長(zhǎng)保存在河段長(zhǎng)度臨時(shí)表中NextElse' 如果河道起點(diǎn)從斷面處開(kāi)始' 計(jì)算河段長(zhǎng)度并將其插入河段長(zhǎng)度表Fetch First From GradientEV = Gradient.Elev' 用來(lái)尋找沒(méi)有吸附的等高線Line1 = Gradient.Obj' 第一條等高線對(duì)象E = LocateCrossing(S, Line1, N)

20、9; 河道與第一條等高線的交點(diǎn)位置For I = 1 To C - 1B=E' 首節(jié)點(diǎn)序號(hào)Fetch Next From GradientEV = Gradient.Elev' 用來(lái)尋找沒(méi)有吸附的等高線Line2 = Gradient.Obj' 下一條等高線E = LocateCrossing(S, Line2, N)' 尾節(jié)點(diǎn)序號(hào)，河道與下一條等高線的交點(diǎn)位置R = ExtractNodes(S, 1, E, B, FALSE)' 抽取河段，按 E -> BL = ObjectLen(R, "m")' 獲取河段長(zhǎng)度In

21、sert Into ReachLen (Length) Values (L) '將河段長(zhǎng)保存在河段長(zhǎng)度臨時(shí)表中NextEnd IfEnd Sub'-' 判斷河道的起點(diǎn)是否在源頭'-Function IsDownStream As LogicalDim S As Object' 河道Dim N As Integer' 河道上的節(jié)點(diǎn)數(shù).精品文檔Dim Line1 As Object '等高線 1Dim Line2 As Object '等高線 2Dim B, E As Integer '河段的首尾節(jié)點(diǎn)序號(hào)' 獲取河道對(duì)

22、象及其節(jié)點(diǎn)數(shù)Fetch First From StreamS = Stream.ObjN = ObjectInfo(S, OBJ_INFO_NPNTS)' 獲取河道與第一條等高線的交點(diǎn)的序號(hào)Fetch First From GradientEV = Gradient.Elev' 用來(lái)尋找沒(méi)有吸附的等高線Line1 = Gradient.Obj' 第一條等高線對(duì)象B = LocateCrossing(S, Line1, N)' 河道與第一條等高線的交點(diǎn)位置' 獲取河道與第二條等高線的交點(diǎn)的序號(hào)Fetch Next From GradientEV = Gra

23、dient.Elev' 用來(lái)尋找沒(méi)有吸附的等高線Line2 = Gradient.Obj' 下一條等高線E = LocateCrossing(S, Line2, N)' 尾節(jié)點(diǎn)序號(hào)，河道與下一條等高線的交點(diǎn)位置IsDownStream = B < EEnd Function'-' 功能：尋找交點(diǎn)的位置（節(jié)點(diǎn)序號(hào)）' 參數(shù)： L 河道對(duì)象' Li 等高線對(duì)象' C 河道的節(jié)點(diǎn)數(shù)' 關(guān)于 IntersectNodes()函數(shù)的說(shuō)明：' 對(duì)于第三個(gè)參數(shù) points_to_include ， INCL_COMMON

24、表示相交于節(jié)點(diǎn)；INCL_CROSSINGS表示相交于線段； INCL_ALL 表示兩種情況 '-Function LocateCrossing(L As Object, Li As Object, ByVal C As Integer)As IntegerDim P As Object' 兩條線的交點(diǎn)Dim Px, Py As Float' 交點(diǎn)坐標(biāo)Dim I As IntegerDim Lx, Ly As Float' 河道線上的節(jié)點(diǎn)坐標(biāo)OnError Goto OnExceptionDo' 如果河道與等高線沒(méi)有吸附，則拋出異常' 獲取兩條折

25、線的交點(diǎn)p = IntersectNodes(L, Li, INCL_COMMON)' 得到交點(diǎn)的坐標(biāo)Px = ObjectNodeX(P, 1, 1).精品文檔Py = ObjectNodeY(P, 1, 1)' 尋找交點(diǎn)的位置（在河道的第幾個(gè)節(jié)點(diǎn)上，折線節(jié)點(diǎn)的編號(hào)按創(chuàng)建順序遞增）For I = 1 To CLx = ObjectNodeX(L, 1, I)Ly = ObjectNodeY(L, 1, I)If (Lx = Px) ThenIf (Ly = Py) Then Exit For End IfEnd IfNextLocateCrossing = IEndExcep

26、tion:' 異常處理Exit FunctionOnExceptionDo:Drop Table ReachLen' 銷毀河段長(zhǎng)度臨時(shí)表Map From Contour' 打開(kāi)等高線圖層Add Map Layer Stream' 添加河道圖層set map redraw offSet Map Layer "Stream" Editable On '使河道圖層可編輯set map redraw onSelect * From Contour Where Elev = EVNote " 請(qǐng)把河道吸附在圖中所示等高線上，并保存St

27、ream 表。 "Resume EndException '0'0 ，指的是嘗試重新執(zhí)行剛才出錯(cuò)的語(yǔ)句。因找不到中斷的辦法，只好放棄。End Function'-' 將河段長(zhǎng)度再導(dǎo)入比降計(jì)算表中'-Sub WriteLen2GradientDim E As IntegerDim L As Float' 將河段長(zhǎng)度一一寫(xiě)入比降計(jì)算表中Fetch First From Gradient' 游標(biāo)指向比降計(jì)算表的第一條記錄Fetch First From ReachLen' 游標(biāo)指向河段長(zhǎng)度表的第一條記錄Do While Not

28、 EOT(ReachLen)E = Gradient.ElevL = ReachLen.LengthSelect * From Gradient Where Elev = EUpdate Selection Set Len = LFetch Next From GradientFetch Next From ReachLenLoop.精品文檔' 銷毀河段長(zhǎng)度臨時(shí)表Drop Table ReachLen' 保存比降計(jì)算表Commit Table Gradient End Sub'-' 功能：計(jì)算河道比降' 算法：統(tǒng)計(jì)河道總長(zhǎng)，計(jì)算河道比降'-Function CalcGradient As FloatDim L As