七、在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