mapbasic程序有詳細的解釋

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

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

3、中 SQL的特性：' (1) Delete 語句，執(zhí)行的是無條件刪除，即刪除表中的全部記錄。它不像SQLServer 的 SQL語句，可以加Where限制從句。'它的 Where Rowid = ?子句用處不大！' (2) Update 語句，執(zhí)行的也是無條件更新，默認情況下，它會更新全部記錄。但是， Update 語句可以通過視圖更新，這就'等價于使用了 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'等高線的高程， 用來查詢當前正在處理的等高線，便于找到沒有吸附的等高線Global ELEV_UNITS As Integer '高程單位選項值'-' 計算河道比降'-Sub MainDim J As Float'河道比降

6、Call OpenTable'打開相關表Call Init' 初始化Call SetupCalcOption'設置計算選項Call WriteElev2Gradient '查詢和河道相交的等高線并將其寫入比降計算表Call AddCrossingOnStream '在河道上添加交點節(jié)點Call GetReachLen' 獲取河段長度，并將其存入河段長度臨時表Call WriteLen2Gradient'將河段長度導入比降計算表中J = CalcGradient()'計算河道比降Call SaveGradient(J)'保存

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

8、ot;", "TAB", "打開等高線 ")GradientFileName = FileOpenDlg("", "", "TAB", "打開比降計算表 ")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' 地圖坐標系（投影）' 設置坐標系（投影）'Map From Stream 'MapWinId = FrontWindow()'MapCoordSys = MapperInfo(MapWinId, MAPPER_INFO_COORDSYS_CLAUSE) 'Set CoordSys Earth' Projection MapCoordSys'Close Window MapWinId' 設

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

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

12、b WriteElev2GradientDim E As Integer' 高程Dim oLine As Object '等高線對象' 清空河段表中的記錄Delete From Gradient' 查詢和主河道相交的等高線Select contour.Elev, contour.Obj From contour, StreamWhere contour.Obj Intersects Stream.ObjOrder By contour.Elev DESCInto Intersection' 將高程值和等高線對象都寫入比降計算表中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' 保存比降計算表Commit Table GradientEnd Sub'-' 在河道上添加和等高線的交點節(jié)點' OverlayNodes() 函數返回添加了交點的折線對象（但是該函數有誤差，有時添加的節(jié)點不能完全

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

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

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

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

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

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

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

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

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

23、dient.Elev' 用來尋找沒有吸附的等高線Line2 = Gradient.Obj' 下一條等高線E = LocateCrossing(S, Line2, N)' 尾節(jié)點序號，河道與下一條等高線的交點位置IsDownStream = B < EEnd Function'-' 功能：尋找交點的位置（節(jié)點序號）' 參數： L 河道對象' Li 等高線對象' C 河道的節(jié)點數' 關于 IntersectNodes()函數的說明：' 對于第三個參數 points_to_include ， INCL_COMMON

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

25、線的交點p = IntersectNodes(L, Li, INCL_COMMON)' 得到交點的坐標Px = ObjectNodeX(P, 1, 1).精品文檔Py = ObjectNodeY(P, 1, 1)' 尋找交點的位置（在河道的第幾個節(jié)點上，折線節(jié)點的編號按創(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' 銷毀河段長度臨時表Map From Contour' 打開等高線圖層Add Map Layer Stream' 添加河道圖層set map redraw offSet Map Layer "Stream" Editable On '使河道圖層可編輯set map redraw onSelect * From Contour Where Elev = EVNote " 請把河道吸附在圖中所示等高線上，并保存St

27、ream 表。 "Resume EndException '0'0 ，指的是嘗試重新執(zhí)行剛才出錯的語句。因找不到中斷的辦法，只好放棄。End Function'-' 將河段長度再導入比降計算表中'-Sub WriteLen2GradientDim E As IntegerDim L As Float' 將河段長度一一寫入比降計算表中Fetch First From Gradient' 游標指向比降計算表的第一條記錄Fetch First From ReachLen' 游標指向河段長度表的第一條記錄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.精品文檔' 銷毀河段長度臨時表Drop Table ReachLen' 保存比降計算表Commit Table Gradient End Sub'-' 功能：計算河道比降' 算法：統(tǒng)計河道總長，計算河道比降'-Function CalcGradient As FloatDim L As