checkoverlapregion.mb

本程序是在GIS软件MapInfo的二次开发语言软件MapBasic中编写

' **********************************
    ' 修改日期：2007.11.4
    ' 内容：合并记录的MapBasic程序
    ' 主要语句：该程序检查是否有图形重叠，在执行程序前需要增加一个整数列flag
    'flag值为1的列为重叠列
' ***********标准定义文件***********
include "mapbasic.def"
include "menu.def"
' **********进程声明****************
Declare Sub Main
Declare Sub Ye_exit
Declare Sub Ye_demo
Declare Sub Ye_dialog
Declare Sub opentable
Declare Sub check
' **********参数定义****************
Dim file,roadname,str,str1,str2 As String
Dim m,n,i,j,k As Integer
Dim num() As Integer
dim myobj as Object
' *************************
'   建立主菜单
' *************************
Sub Main
Alter  Menu Bar add    '创建菜单项
"合并记录","退出"
create menu "合并记录" As 
    "打开表"                  Calling Ye_dialog,
    "检查"                      Calling check
Create MENU "退出" As     
    "退出"                      Calling Ye_exit

'**********设置信息窗口显示位置**********
Set Window Message
    Position(3,2) Units "in"
    Width 4 Units "in"
    Height 2 Units "in"
End Sub
''****************
''  菜单项"测试"
''****************
Sub Ye_demo
    note "这是一个测试程序"
End Sub
''****************
''  菜单项"打开表"
''****************
Sub Ye_dialog
    Dialog
        Title "检查重叠区域"
        Width 200 Height 55
    Control StaticText
        Title "打开表"
        position 5,10
    Control EditText 
        Value ""
        position 35,10 width 120
        ID 1 
    Control Button
        Title "浏览"
        Calling opentable
        position 160,10
    Control OKButton
        Title "确定"
        position 70,30
End Sub
''****************
''  函数"打开表"
''****************
Sub opentable
    file = FileOpenDlg("","","TAB","打开表") '提取路径
'    tablename=pathtotablename$(file)  '提取表名
    open table file as mian
    alter Control 1 Value file
End Sub
''****************
''  菜单项"检查"
''****************
Sub check
    '******初始化******
    print Chr$(12)  '清屏
    update mian set flag=0
    print "*********开始**********"
    m=TableInfo(mian,TAB_INFO_NROWS)
    for i=1 to m
        fetch REC i from mian
        myobj=mian.obj
        select * from mian where RowID<>i into temp
        select * from temp where areaoverlap(myobj,obj)>0 into test
        update test set flag=1
    next
    select * from mian where flag=1
    print "*********结束**********"
End Sub
''****************
''  菜单项"退出"
''****************
Sub Ye_exit
    Create Menu Bar As Default    '' **恢复Maplnfo菜单
        Create ButtonPads  As  Default    ''  ***恢复Maplnfo按钮盒
        Close all
    End Program     '' ***** 结束MAPBASic应用程序
End sub