变为当前层失败，有没有方法

yuangw1234

请教大师：

本人编了一个将所选层变为当前层的Vba程式，

可是失败，请了解的朋友指点

Public Sub dq()
Dim ssetobj1 As AcadSelectionSet
Dim icount1 As Integer
icount1 = ThisDrawing.SelectionSets.Count
While (icount1 > 0)
    If ThisDrawing.SelectionSets.Item(icount1 - 1).Name = "yuan" Then
    ThisDrawing.SelectionSets.Item(icount1 - 1).Delete
    End If
    icount1 = icount1 - 1
    Wend
    Set ssetobj1 = ThisDrawing.SelectionSets.Add("yuan")
    ThisDrawing.Utility.Prompt "please select object"
    ssetobj1.SelectOnScreen
  Dim i1 As Integer
  Dim selobj1 As AcadEntity
  On Error Resume Next
      Set selobj1 = ssetobj1.Item(i1)

  Dim str As String
  str = selobj1.Layer
  ThisDrawing.ActiveLayer = str

xinghesnak

大哥，ThisDrawing.ActiveLayer是个对象，str是个字符串，看你最后的三行，应该改为：

 Dim str As String
 str = selobj1.layer
 Dim layer As AcadLayer
 For Each layer In ThisDrawing.Layers
    If layer.Name = str Then ThisDrawing.ActiveLayer = layer
 Next

 

雪山飞狐_lzh

ThisDrawing.ActiveLayer =ThisDrawing.Layers( str )

xinghesnak

lzh741206斑竹，你的经验很丰富啊，我总是想不起来用简单的方法。。。谢啦！以后改进！

yuangw1234

谢谢各位大师，你们太利害了