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

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