shi 发表于 2012-4-18 21:22:26

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

程序如下所示，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 发表于 2012-4-18 23:52:40

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

dusnknbnd 发表于 2012-4-19 00:52:15

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

shi 发表于 2012-4-19 10:34:53

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

crazylsp 发表于 2012-10-25 18:04:28

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

markc0826 发表于 2012-10-28 02:27:42

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

shi 发表于 2012-11-5 13:32:13

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

是需要获取整个选择集给用户手动操作，
页: [1]
查看完整版本: 过滤嵌套块选择集，能否用于移动呢？