SelectOnScreen的问题

zeng29

请单独试试下面的代码:
Sub SelOnScrLayerPick()
    Dim ssetObj As AcadSelectionSet
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    Set ssetObj = ThisDrawing.PickfirstSelectionSet
    ssetObj.Clear
    FilterType(0) = 8
    FilterData(0) = "图层1"
    ssetObj.SelectOnScreen FilterType, FilterData
    Debug.Print ssetObj.Count
End Sub
这段代码我在几台机械上试过(2002,2004)均没有问题,证明是正确的;由于手头上没有2000,所以不能确定是否是2000版的原因.
如果在 ssetObj.SelectOnScreen FilterType, FilterData 没有出错,表示你的系统没有问题,如果还是出错,肯定是你的CAD系统的问题,建议卸载重装,若仍不能解决问题建议升级到2002或2004.

dazhangyu

该图层既没冻结，也没关闭，而且还是当前图层。
我用ssetobj.select acSelectionSetAll方法试了一下，功能实现了。我现在就更不明白了，为什么这个方法的功能就可以实现，用selectonscreen就出错呢？
我衷心地感谢你们各位版主对我的帮助，真不好意思还得跟你们再讨教。
经过这几次的刀光剑影，dazhangyu更想知道问题出在哪里了！！
各位版主一定要对小弟我帮到底呀，拜托拜托！！

efan2000

SelectOnScreen需要自己手动在屏幕上选择，如果能够选中，那么会出现高亮状态，同时在命令行上显示选中多少，过滤多少。仔细检查一下是否有选中实体。

dazhangyu

没有这些提示信息
是不是我的ACAD2000有问题呀？在哪儿能下载这个软件呢？或更高版本的也行呀

bluemoon

我测试了一下dazhangyu的程序，稍做修改，程序如下：
Sub ce()
    Dim ssetobj As AcadSelectionSet '设置选择对象
    On Error Resume Next
    Set ssetobj = ThisDrawing.SelectionSets.Add("pmbj_sset")
    If Err Then
        Err.Clear
        Set ssetobj = ThisDrawing.SelectionSets.Item("pmbj_sset")
    End If
    ssetobj.Clear
    MsgBox "ssetobj的名字是：" & ssetobj.Name
    MsgBox "当前图层是：" & ThisDrawing.ActiveLayer.Name '当前图层就是pmbj
    Dim stype(0) As Integer
    Dim sdata(0) As Variant
    stype(0) = 8
    sdata(0) = "pmbj"
    ssetobj.SelectOnScreen stype, sdata '当程序执行到这儿时，提示手动选择对象

    ssetobj.Update
     Dim entry As AcadEntity
  For Each entry In ssetobj
   entry.Color = 5
  Next entry
End Sub
我的CAD也是2000 但是没有出现错误啊
我想dazhengyu的意思是不是要求自动选择某个图层的所有实体啊？
如果是这样 我想用selectonscreen 可能不能满足你的要求啊

bluemoon

这样做你看是否能满足你的要求
'***********声明公用变量*************
Public Sset As AcadSelectionSet
'*****************建立选择集***************
Function CreatSSet()     
    Dim ss As AcadSelectionSet
    On Error Resume Next
    Set ss = ThisDrawing.SelectionSets.Add("bluemoon")
    If Err Then
        Err.Clear
        Set ss = ThisDrawing.SelectionSets("bluemoon")
        ss.Clear
    End If
    Set CreatSSet = ss
End Function


'***************得到某图层的所有实体并把其放入选择集中**********
'***************以图层名称作为参数***********
Public Sub GetLayerEntity(NameString As String)
    Dim FType(0) As Integer
    Dim FData(0) As Variant
    FType(0) = 8
    FData(0) = NameString
    Set Sset = CreatSSet
    Sset.Select acSelectionSetAll, , , FType, FData
End Sub
这样就可以把名为NameString的图层中的所有实体放入选择集Sset中 然后你在调用这两个函数就应该能完成你的操作了
只要知道图层名称就可以 不用在手动选择啊
多用函数 好处多多啊

dazhangyu

楼上仁兄的高见让我五体投地，我对你的敬仰如滔滔江水，奔流不息。。。。。
啊？都知道哇？那我就不说了
我的目的达到了!
如果各位高手还能忍耐我的恒心的话，如果再给我一次机会 ，那么我想说：为什么15楼的方法不好使，而16楼的方法咋就那么好使呢？

bluemoon

select 方法的功能是“选取对象的同时将对象放入选择集中”
selectonscreen方法的功能是“提示用户从屏幕点选对象”
两者功能不同 效果也就不一样
不知道这是不是你要的答案
仁兄的学习精神让小生佩服万分

dazhangyu

谢谢
但是selectonscreen后面带参数的意思不就是自动选取指定图层的所有实体吗？

mccad

你还是不明白。
Sset.Select acSelectionSetAll, , , FType, FData
这一句指的是选择图形中所有符合过滤器条件的图元。
而 Sset.SelectOnScreen stype, sdata
指的是让用户选择屏幕上的对象并用过滤器的条件进行过滤。