mapbasic程序有详细的解释

1、精品文档河道比降计算程序mapinfo=' 项目：河道比降计算' 作者：崔军明' 版本： 2.2' 日期： 2009-12-23'' 使用说明：' 1 、新建图层，绘制主河道（也可以复制水系，然后整理出主河道）。' 2 、确定高程的单位（米 / 分米）。如果与主河道相交的等高线的高程单位不统一，则将其修改一致。' 3 、运行此程序，打开需要的表，设置计算选项，计算河道比降。' 4 、如果遇到错误， 根据提示将河道上的节点吸附在等高线上， 并保存河道表 (Stream) 。'关闭全部表（不必保存），重新运行程

2、序。'5 、程序运行结束后，保存计算结果，然后浏览比降计算表(Gradient)。'(1)复查高程列 (Elev) 的单位是否统一，确认设置计算选项时所作的选择是正确的。' 6 、注意，计算某个流域的河道比降时， 只需打开对应部分的等高线图层。如果等高线图层太大，会大大影响计算速度。'='-'MapBasic 的调试方法：' (1)在出错或需要的地方，使用Note（或 Print ）语句将变量的值显示出来。' (2) 在 MapInfo 中，打开 MapBasic 窗口，回车就会执行当前语句。''MapBasic

3、中 SQL的特性：' (1) Delete 语句，执行的是无条件删除，即删除表中的全部记录。它不像SQLServer 的 SQL语句，可以加Where限制从句。'它的 Where Rowid = ?子句用处不大！' (2) Update 语句，执行的也是无条件更新，默认情况下，它会更新全部记录。但是， 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 '在河道上添加交点节点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"' 创建河段长度临时表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'-' 在河道上添加和等高线的交点节点' OverlayNodes() 函数返回添加了交点的折线对象（但是该函数有误差，有时添加的节点不能完全

14、吸附）'-Sub AddCrossingOnStreamDim 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' 在等

15、高线上也添加一个相交节点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' 河道上的节点数Dim I, C As Integer '循环控制变量Dim Line1 As Object '等高线 1Dim Line2 As Object '等高线 2Dim B, E As Integer '河段的首尾节点序号Dim R As Object' 河段对象Dim L As Float' 河段长度' 清空河段长度表Delete From ReachLen' 获取河道对象及其节点数Fetch First From Stream S = Stream.ObjN = Obj

17、ectInfo(S, OBJ_INFO_NPNTS)' 统计等高线条数，控制循环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' 首节点序号Fetch Next From GradientEV = Gradient.Elev' 用来寻找没有吸附的等高线Line2 = Gradient.Obj' 下一条等高线E = LocateCrossing(S, Line2, N)' 尾节点序号，河道与下一条等高线的交点位置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' 首节点序号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")' 获取河段长度In

21、sert Into ReachLen (Length) Values (L) '将河段长保存在河段长度临时表中NextEnd 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 '河段的首尾节点序号' 获取河道对

22、象及其节点数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)' 尾节点序号，河道与下一条等高线的交点位置IsDownStream = B < EEnd Function'-' 功能：寻找交点的位置（节点序号）' 参数： L 河道对象' Li 等高线对象' C 河道的节点数' 关于 IntersectNodes()函数的说明：' 对于第三个参数 points_to_include ， INCL_COMMON

24、表示相交于节点；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' 河道线上的节点坐标OnError Goto OnExceptionDo' 如果河道与等高线没有吸附，则抛出异常' 获取两条折

25、线的交点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 = 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 ，指的是尝试重新执行刚才出错的语句。因找不到中断的办法，只好放弃。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'-' 功能：计算河道比降' 算法：统计河道总长，计算河道比降'-Function CalcGradient As FloatDim L As