mapbasic程序有详细的解释.docx
- 文档编号:29856823
- 上传时间:2023-07-27
- 格式:DOCX
- 页数:12
- 大小:19.02KB
mapbasic程序有详细的解释.docx
《mapbasic程序有详细的解释.docx》由会员分享,可在线阅读,更多相关《mapbasic程序有详细的解释.docx(12页珍藏版)》请在冰豆网上搜索。
mapbasic程序有详细的解释
河道比降计算程序mapinfo
===================================================================
'项目:
河道比降计算
'作者:
崔军明
'版本:
2.2
'日期:
2009-12-23
'
'使用说明:
' 1、新建图层,绘制主河道(也可以复制水系,然后整理出主河道)。
' 2、确定高程的单位(米/分米)。
如果与主河道相交的等高线的高程单位不统一,则将其修改一致。
' 3、运行此程序,打开需要的表,设置计算选项,计算河道比降。
' 4、如果遇到错误,根据提示将河道上的节点吸附在等高线上,并保存河道表(Stream)。
' 关闭全部表(不必保存),重新运行程序。
' 5、程序运行结束后,保存计算结果,然后浏览比降计算表(Gradient)。
'
(1)复查高程列(Elev)的单位是否统一,确认设置计算选项时所作的选择是正确的。
' 6、注意,计算某个流域的河道比降时,只需打开对应部分的等高线图层。
如果等高线图层太大,会大大影响计算速度。
'===================================================================
'---------------------------------------------------------------------------------
'MapBasic的调试方法:
'
(1)在出错或需要的地方,使用Note(或Print)语句将变量的值显示出来。
'
(2)在MapInfo中,打开MapBasic窗口,回车就会执行当前语句。
'
'MapBasic中SQL的特性:
'
(1)Delete语句,执行的是无条件删除,即删除表中的全部记录。
它不像SQLServer的SQL语句,可以加Where限制从句。
' 它的WhereRowid=?
子句用处不大!
'
(2)Update语句,执行的也是无条件更新,默认情况下,它会更新全部记录。
但是,Update语句可以通过视图更新,这就
' 等价于使用了Where子句。
如:
Select*FromTableWherecolumn=?
UpdateSelectionSetColumn=Value,
' 参考MapBasic帮助。
'---------------------------------------------------------------------------------
Include"MAPBASIC.DEF"
DeclareSubMain
DeclareSubOpenTable
DeclareSubInit
DeclareSubSetupCalcOption
DeclareSubWriteElev2Gradient
DeclareSubAddCrossingOnStream
DeclareSubGetReachLen
DeclareSubWriteLen2Gradient
DeclareFunctionIsDownStreamAsLogical
DeclareFunctionLocateCrossing(LAsObject,LiAsObject,ByValCAsInteger)AsInteger
DeclareFunctionCalcGradientAsFloat
DeclareSubSaveGradient(ByValJAsFloat)
GlobalEVAsInteger '等高线的高程,用来查询当前正在处理的等高线,便于找到没有吸附的等高线
GlobalELEV_UNITSAsInteger'高程单位选项值
'----------------------------------------
'计算河道比降
'----------------------------------------
SubMain
DimJAsFloat '河道比降
CallOpenTable '打开相关表
CallInit '初始化
CallSetupCalcOption '设置计算选项
CallWriteElev2Gradient'查询和河道相交的等高线并将其写入比降计算表
CallAddCrossingOnStream'在河道上添加交点节点
CallGetReachLen '获取河段长度,并将其存入河段长度临时表
CallWriteLen2Gradient '将河段长度导入比降计算表中
J=CalcGradient() '计算河道比降
CallSaveGradient(J) '保存计算结果
EndSub
'----------------------------------------
'打开河道、等高线和比降计算表
'----------------------------------------
SubOpenTable
DimStreamFileNameAsString
DimContourFileNameAsString
DimGradientFileNameAsString
'弹出对话框,打开相关表
StreamFileName=FileOpenDlg("","","TAB","打开主河道")
ContourFileName=FileOpenDlg("","","TAB","打开等高线")
GradientFileName=FileOpenDlg("","","TAB","打开比降计算表")
OpenTableStreamFileNameAsStream
OpenTableContourFileNameAsContour
OpenTableGradientFileNameAsGradient
EndSub
'----------------------------------------
'初始化
'----------------------------------------
SubInit
'DimMapWinIdAsInteger '地图窗口ID
'DimMapCoordSysAsString '地图坐标系(投影)
'设置坐标系(投影)
'MapFromStream
'MapWinId=FrontWindow()
'MapCoordSys=MapperInfo(MapWinId,MAPPER_INFO_COORDSYS_CLAUSE)
'SetCoordSysEarth
'ProjectionMapCoordSys
'CloseWindowMapWinId
'设置长度单位为米
SetDistanceUnits"m"
'创建河段长度临时表
CreateTableReachLen(LengthFloat)
OpenTableReachLen
EndSub
'-----------------------------------------------
'设置计算选项
'-----------------------------------------------
SubSetupCalcOption
'定义了河道起点和高程单位两个选项
Dialog
Title"计算选项"
ControlStaticText
Title"高程单位:
"
ControlRadioGroup
Title"米;分米"
IntoELEV_UNITS
ControlOKButton
Title"确定"
ControlCancelButton
Title"取消"
'如果取消设置或关闭了设置窗口,则退出程序
IfNotCommandInfo(CMD_INFO_DLG_OK)Then
DropTableReachLen
CloseTableStream
CloseTableContour
CloseTableGradient
EndProgram
EndIf
EndSub
'--------------------------------------------------
'查询和河道相交的等高线并将其插入比降计算表中
'--------------------------------------------------
SubWriteElev2Gradient
DimEAsInteger '高程
DimoLineAsObject'等高线对象
'清空河段表中的记录
DeleteFromGradient
'查询和主河道相交的等高线
Selectcontour.Elev,contour.ObjFromcontour,Stream
Wherecontour.ObjIntersectsStream.Obj
OrderBycontour.ElevDESC
IntoIntersection
'将高程值和等高线对象都写入比降计算表中
FetchFirstFromIntersection
DoWhileNotEOT(Intersection)
E=Intersection.Elev
oLine=Intersection.Obj
InsertIntoGradient(Elev,Obj)Values(E,oLine)
FetchNextFromIntersection
Loop
'保存比降计算表
CommitTableGradient
EndSub
'-------------------------------------------------
'在河道上添加和等高线的交点节点
'OverlayNodes()函数返回添加了交点的折线对象(但是该函数有误差,有时添加的节点不能完全吸附)
'-------------------------------------------------
SubAddCrossingOnStream
DimSAsObject'河道折线对象
DimCAsObject'与河道相交的等高线对象
DimEAsInteger'高程值,作为更新等高线的条件
'在河道和等高线上添加相交节点
FetchFirstFromGradient
DoWhileNotEOT(Gradient)
'在河道上添加相交节点
S=OverlayNodes(Stream.Obj,Gradient.Obj)'
UpdateStreamSetObj=S
'在等高线上也添加一个相交节点
C=OverlayNodes(Gradient.Obj,Stream.Obj)
E=Gradient.Elev
Select*FromGradientWhereElev=E
UpdateSelectionSetObj=C
FetchNextFromGradient
Loop
EndSub
'--------------------------------------------------
'获取河段长度,并将其存入河段长度临时表中
'关于ExtractNodes()函数的说明:
begin_node要小于end_node
'--------------------------------------------------
SubGetReachLen
DimSAsObject '河道
DimNAsInteger '河道上的节点数
DimI,CAsInteger'循环控制变量
DimLine1AsObject'等高线1
DimLine2AsObject'等高线2
DimB,EAsInteger'河段的首尾节点序号
DimRAsObject '河段对象
DimLAsFloat '河段长度
'清空河段长度表
DeleteFromReachLen
'获取河道对象及其节点数
FetchFirstFromStream
S=Stream.Obj
N=ObjectInfo(S,OBJ_INFO_NPNTS)
'统计等高线条数,控制循环
SelectCount(*)FromGradient
C=Selection.Col1
'河道起点位置不同,计算河段长度时的起止顺序就不同
DimIsDownAsLogical '是否顺流而下
IsDown=IsDownStream()
IfIsDownThen '如果河道起点从源头开始
'计算河段长度并将其插入河段长度表
FetchFirstFromGradient
EV=Gradient.Elev '用来寻找没有吸附的等高线
Line1=Gradient.Obj '第一条等高线对象
E=LocateCrossing(S,Line1,N) '河道与第一条等高线的交点位置
ForI=1ToC-1
B=E '首节点序号
FetchNextFromGradient
EV=Gradient.Elev '用来寻找没有吸附的等高线
Line2=Gradient.Obj '下一条等高线
E=LocateCrossing(S,Line2,N) '尾节点序号,河道与下一条等高线的交点位置
R=ExtractNodes(S,1,B,E,FALSE) '抽取河段,按B->E
L=ObjectLen(R,"m") '获取河段长度
InsertIntoReachLen(Length)Values(L)'将河段长保存在河段长度临时表中
Next
Else '如果河道起点从断面处开始
'计算河段长度并将其插入河段长度表
FetchFirstFromGradient
EV=Gradient.Elev '用来寻找没有吸附的等高线
Line1=Gradient.Obj '第一条等高线对象
E=LocateCrossing(S,Line1,N) '河道与第一条等高线的交点位置
ForI=1ToC-1
B=E '首节点序号
FetchNextFromGradient
EV=Gradient.Elev '用来寻找没有吸附的等高线
Line2=Gradient.Obj '下一条等高线
E=LocateCrossing(S,Line2,N) '尾节点序号,河道与下一条等高线的交点位置
R=ExtractNodes(S,1,E,B,FALSE) '抽取河段,按E->B
L=ObjectLen(R,"m") '获取河段长度
InsertIntoReachLen(Length)Values(L)'将河段长保存在河段长度临时表中
Next
EndIf
EndSub
'--------------------------------------------------
'判断河道的起点是否在源头
'--------------------------------------------------
FunctionIsDownStreamAsLogical
DimSAsObject '河道
DimNAsInteger '河道上的节点数
DimLine1AsObject'等高线1
DimLine2AsObject'等高线2
DimB,EAsInteger'河段的首尾节点序号
'获取河道对象及其节点数
FetchFirstFromStream
S=Stream.Obj
N=ObjectInfo(S,OBJ_INFO_NPNTS)
'获取河道与第一条等高线的交点的序号
FetchFirstFromGradient
EV=Gradient.Elev '用来寻找没有吸附的等高线
Line1=Gradient.Obj '第一条等高线对象
B=LocateCrossing(S,Line1,N) '河道与第一条等高线的交点位置
'获取河道与第二条等高线的交点的序号
FetchNextFromGradient
EV=Gradient.Elev '用来寻找没有吸附的等高线
Line2=Gradient.Obj '下一条等高线
E=LocateCrossing(S,Line2,N) '尾节点序号,河道与下一条等高线的交点位置
IsDownStream=B EndFunction '-------------------------------------------------- '功能: 寻找交点的位置(节点序号) '参数: L河道对象 ' Li等高线对象 ' C河道的节点数 '关于IntersectNodes()函数的说明: '对于第三个参数points_to_include,INCL_COMMON表示相交于节点;INCL_CROSSINGS表示相交于线段;INCL_ALL表示两种情况 '-------------------------------------------------- FunctionLocateCrossing(LAsObject,LiAsObject,ByValCAsInteger)AsInteger DimPAsObject '两条线的交点 DimPx,PyAsFloat '交点坐标 DimIAsInteger DimLx,LyAsFloat '河道线上的节点坐标 OnErrorGotoOnExceptionDo '如果河道与等高线没有吸附,则抛出异常 '获取两条折线的交点 p=IntersectNodes(L,Li,INCL_COMMON) '得到交点的坐标 Px=ObjectNodeX(P,1,1) Py=ObjectNodeY(P,1,1) '寻找交点的位置(在河道的第几个节点上,折线节点的编号按创建顺序递增) ForI=1ToC Lx=ObjectNodeX(L,1,I) Ly=ObjectNodeY(L,1,I) If(Lx=Px)Then If(Ly=Py)ThenExitForEndIf EndIf Next LocateCrossing=I EndException: '异常处理 ExitFunction OnExceptionDo: DropTableReachLen '销毁河段长度临时表 MapFromContour '打开等高线图层 AddMapLayerStream '添加河道图层 setmapredrawoff SetMapLayer"Stream"EditableOn'使河道图层可编辑 setmapredrawon Select*FromContourWhereElev=EV Note"请把河道吸附在图中所示等高线上,并保存Stream表。 " ResumeEndException'0 '0,指的是尝试重新执行刚才出错的语句。 因找不到中断的办法,只好放弃。 EndFunction '---------------------------------------- '将河段长度再导入比降计算表中 '---------------------------------------- SubWriteLen2Gradient DimEAsInteger DimLAsFloat '将河段长度一一写入比降计算表中 FetchFirstFromGradient '游标指向比降计算表的第一条记录 FetchFirstFromReachLen '游标指向河段长度表的第一条记录 DoWhileNotEOT(ReachLen) E=Gradient.Elev L=ReachLen.Length Select*FromGradientWhereElev=E UpdateSelectionSetLen=L FetchNextFromGradient FetchNextFromReachLen Loop '销毁河段长度临时表 DropTableReachLen '保存比降计算表 CommitTableGradient EndSub '---------------------------------------- '功能: 计算河道比降 '算法: 统计河道总长,计算河道比降 '---------------------------------------- FunctionCalcGradientAsFloat DimLAsFloat'河道总长 DimCAsInteger'总记录数 DimIAsInteger DimH1AsInteger'河段上断面河底高程 DimH2AsInteger'河段下断面河底高程 DimL1AsFloat'河段长度 DimJAsFloat'河道比降 '统计河道总长和河段断面的数量(河段数量加1) SelectSum(Len),Count(
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- mapbasic 程序 详细 解释
![提示](https://static.bdocx.com/images/bang_tan.gif)