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

shi

程序如下所示，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

ufun5222

楼主，你的高尚情操太让人感动了。在现在这样一个物欲横流的金钱社会里，竟然还能见到楼主这样%D

dusnknbnd

这个资源我找了好久好久，终于发现了这里，下载吧，还多说什么了。

shi

看来现在用vba做二次开发的太少了，vba版块一天才有几个帖子，相比lisp差远了

crazylsp

既然有了选择集，为何不对选择集成员move或copy，for each obj in sset1  obj.move...  next ?

markc0826

如五楼所云，直接对元件作移动，有需要用sendcommand?

shi

markc0826 发表于 2012-10-28 02:27
如五楼所云，直接对元件作移动，有需要用sendcommand?

是需要获取整个选择集给用户手动操作，