MapX应用教程(7)—在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