过滤嵌套块选择集，能否用于移动呢？

shi · 发表于 2012-4-18 21:22:00

程序如下所示，sset取得块选择集，sset1为遍历sset取得的嵌套块选择集，
现在想在vba运行完之后move或copy选择集sset1，但最后这两句
      ThisDrawing.SendCommand "move "
      ThisDrawing.SendCommand "p"
只能move 选择集sset，求高手帮忙
Sub qtk()
Dim obj As AcadEntity, s(0) As AcadEntity
Dim sset As AcadSelectionSet, sset1 As AcadSelectionSet
Dim Filtertype(0) As Integer  '
Dim Filterdata(0) As Variant
Dim removeObject(0) As AcadEntity
Dim ss As New TlsSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets.Item("k1").Delete
ThisDrawing.SelectionSets.Item("k2").Delete
On Error GoTo 0
Set sset = ThisDrawing.SelectionSets.Add("k1")
Set sset1 = ThisDrawing.SelectionSets.Add("k2")
Filtertype(0) = 0
Filterdata(0) = "Insert" '实体类型-图块
sset.SelectOnScreen Filtertype, Filterdata
For Each s(0) In sset
      blockname = s(0).EffectiveName
      For Each obj In ThisDrawing.Blocks(blockname) '遍历图块子图元
         If obj.ObjectName = "AcDbBlockReference" Then
                  sset1.AddItems s
               Exit For
         End If
      Next
Next
sset.Clear
sset.Delete
ThisDrawing.SendCommand "move "
ThisDrawing.SendCommand "p"

End Sub