1、河道比降计算程序 mapinfo= 项目：河道比降计算 作者：崔军明 版本：2.2 日期：2009-12-23 使用说明： 1、新建图层，绘制主河道（也可以复制水系，然后整理出主河道）。 2、确定高程的单位（米/分米）。如果与主河道相交的等高线的高程单位不统一，则将其修改一致。 3、运行此程序，打开需要的表，设置计算选项，计算河道比降。 4、如果遇到错误，根据提示将河道上的节点吸附在等高线上， 并保存河道表(Stream)。 关闭全部表（不必保存），重新运行程序。 5、程序运行结束后，保存计算结果，然后浏览比降计算表(Gradient)。 (1) 复查高程列(Elev)的单位是否统一，确认设置
2、计算选项时所作的选择是正确的。 6、注意，计算某个流域的河道比降时，只需打开对应部分的等高线图层。 如果等高线图层太大，会大大影响计算速度。= -MapBasic 的调试方法： (1) 在出错或需要的地方，使用 Note（或 Print）语句将变量的值显示出来。 (2) 在 MapInfo 中，打开 MapBasic 窗口，回车就会执行当前语句。MapBasic 中 SQL 的特性： (1) Delete 语句，执行的是无条件删除，即删除表中的全部记录。它不像SQL Server 的 SQL 语句，可以加 Where 限制从句。 它的 Where Rowid = ? 子句用处不大！ (2) U
3、pdate 语句，执行的也是无条件更新，默认情况下，它会更新全部记录。但是，Update 语句可以通过视图更新，这就 等价于使用了 Where 子句。如：Select * From Table Where column = ? , Update Selection Set Column = Value， 参考 MapBasic 帮助。-Include “MAPBASIC.DEF“Declare Sub MainDeclare Sub OpenTableDeclare Sub InitDeclare Sub SetupCalcOptionDeclare Sub WriteElev2Gradien
4、tDeclare Sub AddCrossingOnStreamDeclare Sub GetReachLenDeclare Sub WriteLen2GradientDeclare Function IsDownStream As LogicalDeclare Function LocateCrossing(L As Object, Li As Object, ByVal C As Integer) As IntegerDeclare Function CalcGradient As FloatDeclare Sub SaveGradient(ByVal J As Float)Global
5、EV As Integer 等高线的高程，用来查询当前正在处理的等高线，便于找到没有吸附的等高线Global ELEV_UNITS As Integer 高程单位选项值-计算河道比降-Sub MainDim J As Float 河道比降Call OpenTable 打开相关表Call Init 初始化Call SetupCalcOption 设置计算选项Call WriteElev2Gradient 查询和河道相交的等高线并将其写入比降计算表Call AddCrossingOnStream 在河道上添加交点节点Call GetReachLen 获取河段长度，并将其存入河段长度临时表Call
6、WriteLen2Gradient 将河段长度导入比降计算表中J = CalcGradient() 计算河道比降Call SaveGradient(J) 保存计算结果End Sub-打开河道、等高线和比降计算表-Sub OpenTableDim StreamFileName As StringDim ContourFileName As StringDim GradientFileName As String弹出对话框，打开相关表StreamFileName = FileOpenDlg(“, “, “TAB“, “打开主河道“)ContourFileName = FileOpenDlg(“,
7、“, “TAB“, “打开等高线“)GradientFileName = FileOpenDlg(“, “, “TAB“, “打开比降计算表“)Open Table StreamFileName As StreamOpen Table ContourFileName As ContourOpen Table GradientFileName As GradientEnd Sub-初始化-Sub InitDim MapWinId As Integer 地图窗口 IDDim MapCoordSys As String 地图坐标系（投影）设置坐标系（投影）Map From StreamMapWinI
8、d = FrontWindow()MapCoordSys = MapperInfo(MapWinId, MAPPER_INFO_COORDSYS_CLAUSE)Set CoordSys Earth Projection MapCoordSysClose Window MapWinId设置长度单位为米Set Distance Units “m“创建河段长度临时表Create Table ReachLen (Length Float)Open Table ReachLenEnd Sub-设置计算选项-Sub SetupCalcOption定义了河道起点和高程单位两个选项DialogTitle “计
9、算选项“Control StaticTextTitle “高程单位：“Control RadioGroupTitle “米;分米“Into ELEV_UNITSControl OKButtonTitle “确定“Control CancelButtonTitle “取消“如果取消设置或关闭了设置窗口，则退出程序If Not CommandInfo(CMD_INFO_DLG_OK) ThenDrop Table ReachLenClose Table StreamClose Table ContourClose Table GradientEnd ProgramEnd IfEnd Sub-查询和
10、河道相交的等高线并将其插入比降计算表中-Sub 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 From In
11、tersectionDo While Not EOT(Intersection)E = Intersection.ElevoLine = Intersection.ObjInsert Into Gradient (Elev, Obj) Values (E, oLine)Fetch Next From IntersectionLoop保存比降计算表Commit Table GradientEnd Sub-在河道上添加和等高线的交点节点 OverlayNodes() 函数返回添加了交点的折线对象（但是该函数有误差，有时添加的节点不能完全吸附）-Sub AddCrossingOnStreamDim
12、S As Object 河道折线对象Dim C As Object 与河道相交的等高线对象Dim E As Integer 高程值，作为更新等高线的条件在河道和等高线上添加相交节点Fetch First From GradientDo While Not EOT(Gradient)在河道上添加相交节点S = OverlayNodes(Stream.Obj, Gradient.Obj) Update Stream Set Obj = S在等高线上也添加一个相交节点C = OverlayNodes(Gradient.Obj, Stream.Obj)E = Gradient.ElevSelect *
13、 From Gradient Where Elev = EUpdate Selection Set Obj = CFetch Next From GradientLoopEnd Sub-获取河段长度，并将其存入河段长度临时表中关于 ExtractNodes()函数的说明：begin_node 要小于 end_node-Sub GetReachLenDim S As Object 河道Dim N As Integer 河道上的节点数Dim I, C As Integer 循环控制变量Dim Line1 As Object 等高线 1Dim Line2 As Object 等高线 2Dim B,
14、E As Integer 河段的首尾节点序号Dim R As Object 河段对象Dim L As Float 河段长度清空河段长度表Delete From ReachLen获取河道对象及其节点数Fetch First From StreamS = Stream.ObjN = ObjectInfo(S, OBJ_INFO_NPNTS)统计等高线条数，控制循环Select Count(*) From GradientC = Selection.Col1河道起点位置不同，计算河段长度时的起止顺序就不同Dim IsDown As Logical 是否顺流而下IsDown = IsDownStrea
15、m()If IsDown Then 如果河道起点从源头开始计算河段长度并将其插入河段长度表Fetch First From GradientEV = Gradient.Elev 用来寻找没有吸附的等高线Line1 = Gradient.Obj 第一条等高线对象E = LocateCrossing(S, Line1, N) 河道与第一条等高线的交点位置For I = 1 To C - 1B = E 首节点序号 Fetch Next From GradientEV = Gradient.Elev 用来寻找没有吸附的等高线Line2 = Gradient.Obj 下一条等高线E = LocateCr
16、ossing(S, Line2, N) 尾节点序号，河道与下一条等高线的交点位置R = ExtractNodes(S, 1, B, E, FALSE) 抽取河段，按 B - EL = ObjectLen(R, “m“) 获取河段长度 Insert Into ReachLen (Length) Values (L) 将河段长保存在河段长度临时表中NextElse 如果河道起点从断面处开始计算河段长度并将其插入河段长度表Fetch First From GradientEV = Gradient.Elev 用来寻找没有吸附的等高线Line1 = Gradient.Obj 第一条等高线对象E = L
17、ocateCrossing(S, Line1, N) 河道与第一条等高线的交点位置For I = 1 To C - 1B = E 首节点序号 Fetch Next From GradientEV = Gradient.Elev 用来寻找没有吸附的等高线Line2 = Gradient.Obj 下一条等高线E = LocateCrossing(S, Line2, N) 尾节点序号，河道与下一条等高线的交点位置R = ExtractNodes(S, 1, E, B, FALSE) 抽取河段，按 E - BL = ObjectLen(R, “m“) 获取河段长度 Insert Into ReachL
18、en (Length) Values (L) 将河段长保存在河段长度临时表中Next End IfEnd Sub-判断河道的起点是否在源头-Function IsDownStream As LogicalDim S As Object 河道Dim N As Integer 河道上的节点数Dim Line1 As Object 等高线 1Dim Line2 As Object 等高线 2Dim B, E As Integer 河段的首尾节点序号获取河道对象及其节点数Fetch First From StreamS = Stream.ObjN = ObjectInfo(S, OBJ_INFO_NP
19、NTS)获取河道与第一条等高线的交点的序号Fetch First From GradientEV = Gradient.Elev 用来寻找没有吸附的等高线Line1 = Gradient.Obj 第一条等高线对象B = LocateCrossing(S, Line1, N) 河道与第一条等高线的交点位置获取河道与第二条等高线的交点的序号Fetch Next From GradientEV = Gradient.Elev 用来寻找没有吸附的等高线Line2 = Gradient.Obj 下一条等高线E = LocateCrossing(S, Line2, N) 尾节点序号，河道与下一条等高线的交
20、点位置 IsDownStream = B EEnd Function-功能：寻找交点的位置（节点序号）参数： L 河道对象 Li 等高线对象 C 河道的节点数 关于 IntersectNodes()函数的说明： 对于第三个参数 points_to_include，INCL_COMMON 表示相交于节点；INCL_CROSSINGS 表示相交于线段；INCL_ALL 表示两种情况-Function LocateCrossing(L As Object, Li As Object, ByVal C As Integer) As IntegerDim P As Object 两条线的交点Dim Px
21、, Py As Float 交点坐标Dim I As IntegerDim Lx, Ly As Float 河道线上的节点坐标OnError Goto OnExceptionDo 如果河道与等高线没有吸附，则抛出异常获取两条折线的交点p = IntersectNodes(L, Li, INCL_COMMON) 得到交点的坐标Px = ObjectNodeX(P, 1, 1)Py = ObjectNodeY(P, 1, 1)寻找交点的位置（在河道的第几个节点上，折线节点的编号按创建顺序递增）For I = 1 To CLx = ObjectNodeX(L, 1, I)Ly = ObjectNod
22、eY(L, 1, I)If (Lx = Px) ThenIf (Ly = Py) Then Exit For End IfEnd IfNext LocateCrossing = IEndException: 异常处理Exit FunctionOnExceptionDo:Drop Table ReachLen 销毁河段长度临时表Map From Contour 打开等高线图层Add Map Layer Stream 添加河道图层set map redraw off Set Map Layer “Stream“ Editable On 使河道图层可编辑set map redraw onSelect
23、 * From Contour Where Elev = EVNote “请把河道吸附在图中所示等高线上，并保存 Stream 表。“Resume EndException 0 0，指的是尝试重新执行刚才出错的语句。因找不到中断的办法，只好放弃。End Function-将河段长度再导入比降计算表中-Sub WriteLen2GradientDim E As IntegerDim L As Float将河段长度一一写入比降计算表中Fetch First From Gradient 游标指向比降计算表的第一条记录Fetch First From ReachLen 游标指向河段长度表的第一条记录D
24、o While Not 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 GradientEnd Sub-功能：计算河道比降算法：统计河道总长，计算河道比降-Function CalcGradient As FloatDi
25、m L As Float 河道总长 Dim C As Integer 总记录数Dim I As IntegerDim H1 As Integer 河段上断面河底高程Dim H2 As Integer 河段下断面河底高程Dim L1 As Float 河段长度Dim J As Float 河道比降 统计河道总长和河段断面的数量（河段数量加 1）Select Sum(Len), Count(*) From GradientL = Selection.Col1C = Selection.Col2计算河道比降J = 0 Fetch First From GradientFor I = 1 to C -
26、 1L1 = Gradient.LenH1 = Gradient.Elev Fetch Next From GradientH2 = Gradient.Elev J = J + (H1 + H2)*L1 Next J = (J - 2 * H2 * L)/L2如果高程单位为分米，则 J/10If ELEV_UNITS = 2 ThenJ = J / 10End IfCalcGradient = JEnd Function -保存河道比降-Sub SaveGradient(ByVal J As Float)Note “河道比降为：“ + Str$(J)浏览比降计算表Browse * From Gradient将结果存入河道比降表中Dim FN As StringFN = FileSaveAsDlg(“,“,“TAB“,“保存计算结果“)Create Table 河道比降(河道比降 Float)File FN将河道比降值保存在表中Insert Into 河道比降 (河道比降) Values (J)保存河道比降表Commit Table 河道比降浏览河道比降值Browse * From 河道比降End Sub
