如何实现关闭已选择实体的图层？？

egua

想编一个程序：

输入命令，从屏幕选择实体，程序判断已选实体的图层，然后将其关闭！

判高手指点一下～

wyj7485

2. Sub test()
3. Dim Obj As Object
4. Dim PickP As Variant
5. ThisDrawing.Utility.GetEntity Obj, PickP, "选择要关闭该层的图元:"
6. ThisDrawing.Layers.Item(Obj.Layer).LayerOn = False
7. End Sub

Sub test() Dim Obj As Object Dim PickP As Variant ThisDrawing.Utility.GetEntity Obj, PickP, "选择要关闭该层的图元:" ThisDrawing.Layers.Item(Obj.Layer).LayerOn = False End Sub

egua

多谢啦

还想问问如果用选择集的方法可以么？

同时实现cad的框选功能，并且像输入cad命令一样，敲选回车后才关闭图层～

wyj7485

选择集当然可以，只是选择集里的实体不一定都在一个层上，这样就要遍历选择集来处理

egua

多谢斑竹，我写了如下代码：看看有什么问题哦

2. Sub test()
3. Dim ssetobj As AcadSelectionSet
4. Dim s As AcadSelectionSet
5. On Error Resume Next
6.      Set ssetobj = ThisDrawing.SelectionSets.Add("egua")
7.      If Err Then
8.          Err.Clear
9.          Set ssetobj = ThisDrawing.SelectionSets.Item("egua")
10.      End If
11.      ssetobj.Clear
13. ssetobj.SelectOnScreen
14. For Each s In ssetobj
15. ThisDrawing.Layers.Item(s.Layer).LayerOn = False
16. Next s
17. End Sub

Sub test() Dim ssetobj As AcadSelectionSet Dim s As AcadSelectionSet On Error Resume Next      Set ssetobj = ThisDrawing.SelectionSets.Add("egua")      If Err Then          Err.Clear          Set ssetobj = ThisDrawing.SelectionSets.Item("egua")      End If      ssetobj.Clear ssetobj.SelectOnScreen For Each s In ssetobj ThisDrawing.Layers.Item(s.Layer).LayerOn = False Next s End Sub

afeng11

Sub test()
Dim ssetobj As AcadSelectionSet
Dim s As AcadSelectionSet这里有问题，要改成这样：Dim s As AcadEntity
On Error Resume Next
     Set ssetobj = ThisDrawing.SelectionSets.Add("egua")
     If Err Then
         Err.Clear
         Set ssetobj = ThisDrawing.SelectionSets.Item("egua")
     End If
     ssetobj.Clear

ssetobj.SelectOnScreen
For Each s In ssetobj
     ThisDrawing.Layers.Item(s.Layer).LayerOn = False
Next s
End Sub

sousence