关于紧缩表？

<P>HI，大家好！</P>
<P>      为啥我能把原表上的数据复制到临时表上，而不能把临时表上的数据再复制到原理的地图上图层中。thanks
郁闷</P>

<P>纠正：不能把临时图层中的物体复制到原来地图中新创建的表中！</P><P>各位大侠</P><img src="images/post/smile/dvbbs/em02.gif" />了！

<P>你有可能有变量没有SET NOTHING？</P>
<P>下面的代码是我测试过，你可以参考一下</P>
<P>Private Sub PackTable(LayerName As String, SourceMap As Map, PackMap As Map)
    Dim lyr As New MapXLib.Layer
    Dim Ds As New MapXLib.Dataset
    Dim LayerInfo As New MapXLib.LayerInfo
    Dim TempLayerName, Path As String
    </P>
<P>
 
   TempLayerName = "TempPackTable"
   Set lyr = SourceMap.Layers.Item(LayerName)
   Set Ds = SourceMap.Datasets.Add(miDataSetLayer, lyr, LayerName)</P>
<P>   '选定图层的存放路径
   Path = SourceMap.Layers.Item(LayerName).Filespec</P>
<P>   '创建临时表</P>
<P>   LayerInfo.Type = miLayerInfoTypeTemp
   LayerInfo.AddParameter "filespec", Path
   LayerInfo.AddParameter "Name", TempLayerName
   LayerInfo.AddParameter "Fields", Ds.Fields
   LayerInfo.AddParameter "Features", lyr.AllFeatures
   LayerInfo.AddParameter "AutoCreateDataset", 1
   LayerInfo.AddParameter "datasetname", TempLayerName</P>
<P>   PackMap.Layers.Add LayerInfo, 0
   PackMap.Refresh</P>
<P>   '移出图层
   SourceMap.Datasets.Remove (LayerName)
   SourceMap.Layers.Remove (LayerName)
   SourceMap.Refresh</P>
<P>   '删除 Tab 表文件
  ' DeleteFile (Path)
  If Dir(App.Path ; "\" ; LayerName ; ".*") <> "" Then
    Kill (App.Path ; "\" ; LayerName ; ".*")
  End If</P>
<P>   '重新绑定
   Set lyr = Nothing
   Set Ds = Nothing
   Set LayerInfo = Nothing
  
   Set lyr = PackMap.Layers.Item(TempLayerName)
   Set Ds = PackMap.Datasets.Add(miDataSetLayer, lyr, LayerName)
   Set flds = Ds.Fields
   '创建表
   LayerInfo.Type = miLayerInfoTypeNewTable
   LayerInfo.AddParameter "filespec", Path
   LayerInfo.AddParameter "Name", LayerName
   LayerInfo.AddParameter "Fields", Ds.Fields
   LayerInfo.AddParameter "Features", lyr.AllFeatures
   LayerInfo.AddParameter "AutoCreateDataset", 1
   LayerInfo.AddParameter "datasetname", LayerName</P>
<P>   SourceMap.Layers.Add LayerInfo, 0
   SourceMap.Refresh</P>
<P>   '移出图层
   PackMap.Datasets.Remove (LayerName)
   PackMap.Layers.Remove (TempLayerName)
   PackMap.Refresh</P>
<P>End Sub</P>

<P>Thanks a lot !</P><img src="images/post/smile/dvbbs/em02.gif" /> 了！

<P>to echo2003 ,我用你提供的代码试试也不行的，还是那样的错误新建的图层没物体？请指导指导，我的代码如下：</P><P>'创建临时地图
   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 = Map1.Layers.Count To 1 Step -1
     '' ;acute;复制源表数据到临时表
'      Set Lyr = Map1.Layers.Item(I)
      Set lyr = Map1.Layers.Item(i)
      Set Ds = lyr.DataSets.Item(i)
      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 = Map2.Layers.Add(LayerInfo, 1)    '复制到另外Map对象
      '''
       Map2.Refresh
     '''
    
     '' ;acute;删除源表
      Set lyr = Nothing
      FilePath = Map1.Layers.Item(i).FileSpec
      LayerName = Mid(FilePath, InStr(1, FilePath, "Maps") + 5, Len(FilePath) - InStr(1, FilePath, "Maps"))
      FilePath = Mid(FilePath, 1, InStr(1, FilePath, "Maps") + 4)
      LayerName = Mid(LayerName, 1, Len(LayerName) - 4)
      
      '''''
      Map1.DataSets.Remove (LayerName)
      ''''
      Map1.Layers.Remove (i)
      Map1.Refresh
      
      Kill FilePath + LayerName + ".TAB"
      '' ;acute;复制临时表数据到源表
     '''
      Set lyr = Nothing
      Set Ds = Nothing
      Set LayerInfo = Nothing
      </P><P>     '''
      Set LyrTemp = Map2.Layers.Item(LayerName)
      
      '''
      Set Ds = Map2.DataSets.Add(miDataSetLayer, LyrTemp, LayerName)
      Set Flds = Ds.Fields
      '''
      Map2.Refresh
      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
    
  
       Dim lyrT As New Layer
      Set lyr = Map1.Layers.Add(LayerInfo, 1)
      lyr.Refresh
    
      Map1.Refresh
<FONT color=#000000>      MsgBox lyr.AllFeatures.Count         ‘<FONT color=#ff0000>提示没有物体</FONT>？</FONT>
      '为啥临时表上的数据不能复制到原表上？？？？？？？？？？？
    
      Namelyr = LayerName
      '';acute;删除临时表
'     map2.Layers.Remove (map2.Layers.Count)
      Map2.Layers.Remove (LyrTemp)
      Map2.Refresh
   Next
Set lyrT = Nothing
'Set Ds = Nothing
Set Flds = Nothing
Set LayerInfo = Nothing
郁闷！</P>

<P>to echo2003 !<img src="images/post/smile/dvbbs/em04.gif" /></P><P>解决了！</P>