紧缩表源代码
Include "mapbasic.def"
Include "icons.def"
Include "menu.def"
'***********************************************************
Declare Sub Main
Declare Sub packtable
Declare Sub BatchPackTable
Declare Sub Exit
'***********************************************************
Sub Main
Create Menu "紧缩表" As
"(-",
"紧缩表" +Chr$(9)+"Ctrl+M/W^M" Calling PackTable,
"(-",
"退出"Calling Exit
Alter Menu Bar Add "紧缩表"
Set Window Message Font ("宋体", 0, 10, Blue)
End Sub
'***********************************************************
Sub PackTable
Dim Ptable,LayName As String
Dim Winid,I,J,LayNums As Integer
Cls
onError GoTo ErrorType
If Not FrontWindow() Then
Note "没有图层，请打开图层......"
Exit Sub
End If
For j=1 To NumWindows()
If WindowInfo(FrontWindow(),Win_Info_Type)<>Win_Mapper Then
Close Window FrontWindow()
Else
Exit For
End If
Next
Winid=FrontWindow()
LayNums=MapperInfo(WinID, Mapper_Info_Layers)
Open File "c:\紧缩完的表.txt" For Output As #2
For I=1 To Laynums
LayName= LayerInfo(WinID,I,Layer_Info_Name)
If LayerInfo(WinID,I,Layer_Info_type)=Layer_Info_Type_Normal Then
Commit Table LayName
Set Map Layer LayName Editable On
Ptable="Pack Table "+LayName+" Graphic Data "
Run Command Ptable
Print "已经将 ("+LayName+") 表紧缩完！ "
Print #2, "已经将 ("+LayName+") 表紧缩完！ "
If LayNums>1 Then
Add Map Auto Layer LayName
Else
Map From LayName
End If
End If
Next
Close File #2
Note "紧缩完毕！"
Exit Sub
ErrorType:
Exit Sub
Print "操作被取消！"
End Sub
'***********************************************************
Sub Exit
If Ask("Hi！你是否愿意退出？","是","否") = 1 Then
End Program
End If
End Sub