在MapX下紧缩表

在MapX下紧缩表

在Professional里面，紧缩表用 Pack Table 语句完成。而在MapX中则需要使用临时图层
，并用复制技术来完成。示例：
‘紧缩当前Map对象中的所有图层
   Dim LayerInfo As New MapXLib.LayerInfo
   Dim Lyr As MapXLib.Layer
   Dim LyrTemp As MapXLib.Layer
   Dim Flds As MapXLib.Fields
   Dim Ds As MapXLib.Dataset
   
   Dim I As Integer
   Dim LayerName, FilePath As String
   
   On Error Resume Next
   
   For I = MainMap.Layers.Count To 1 Step -1
      ´复制源表数据到临时表
      Set Lyr = MainMap.Layers.Item(I)
      Set Ds = Lyr.Datasets.Item(1)
      Set Flds = Ds.Fields
      
      LayerName = Lyr.Name
      
      LayerInfo.Type = miLayerInfoTypeTemp
      LayerInfo.AddParameter "FileSpec", LayerName
      LayerInfo.AddParameter "NAME", LayerName
     LayerInfo.AddParameter "Features", Lyr.AllFeatures‘复制所有有效图元
      LayerInfo.AddParameter "Fields", Flds    ’复制字段列表
      
      LayerInfo.AddParameter "AutoCreateDataset", 1
      LayerInfo.AddParameter "datasetname", LayerName
Set LyrTemp = MapTemp.Layers.Add(LayerInfo, 1)    ‘复制到另外Map对象
      
      ´删除源表
      Set Lyr = Nothing
      FilePath = MainMap.Layers.Item(I).Filespec
      LayerName = Mid(FilePath, InStr(1, FilePath, "Maps") + 6, Len(FilePath)
- InStr(1, FilePath, "Maps"))
      FilePath = Mid(FilePath, 1, InStr(1, FilePath, "Maps") + 5)
      LayerName = Mid(LayerName, 1, Len(LayerName) - 4)
      
      MainMap.Layers.Remove (I)
      MainMap.Refresh
      
      Kill FilePath + LayerName + ".TAB"
      
      ´复制临时表数据到源表
      Set LyrTemp = MapTemp.Layers.Item(LayerName)

      LayerInfo.Type = miLayerInfoTypeNewTable
      LayerInfo.AddParameter "FileSpec", FilePath + LayerName + ".TAB"
      LayerInfo.AddParameter "NAME", LayerName
      LayerInfo.AddParameter "Features", LyrTemp.AllFeatures
      LayerInfo.AddParameter "Fields", Flds
        
      LayerInfo.AddParameter "AutoCreateDataset", 1
      LayerInfo.AddParameter "datasetname", LayerName
      Set Lyr = MainMap.Layers.Add(LayerInfo, 1)
      
      ´删除临时表
      MapTemp.Layers.Remove (MapTemp.Layers.Count)
      MapTemp.Refresh
   Next
      
   Set Lyr = Nothing
   Set Ds = Nothing
   Set Flds = Nothing
   Set LayerInfo = Nothing