社区 › VB › 变为当前层失败，有没有方法

yuangw1234 发表于 2006-4-8 10:09:00

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

请教大师：
本人编了一个将所选层变为当前层的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 发表于 2006-4-8 10:51:00

大哥，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 发表于 2006-4-8 15:41:00

ThisDrawing.ActiveLayer =ThisDrawing.Layers( str )

xinghesnak 发表于 2006-4-8 16:08:00

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

yuangw1234 发表于 2006-4-8 17:28:00

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

查看完整版本: 变为当前层失败，有没有方法