请教各位高手一个简单的问题

bluemoon

我想对某个图层中的对象进行操作
运行for each ent in thisdrawing.layer(i)时提示出错 对象不对
请问我该如何更改呢？
谢先

mccad

图层中是没有对象的。
你必须使用带过滤器的选择集来选择指定图层下的对象，然后再对这些对象进行操作。

mccad

这是一个转换对象图层的程序，你看看吧：

2. Sub ChgLayer()
   
3.     On Error Resume Next
   
4.     Dim Ent As AcadEntity
   
5.     Dim Pnt As Variant
   
6.     ThisDrawing.Utility.GetEntity Ent, Pnt, vbCrLf & "选择所要改变图层的对象:"
   
7.    
   
8.     Dim LayName As String
   
9.     LayName = Ent.Layer
   
10.     ThisDrawing.Utility.Prompt vbCrLf & "你选择转换的图层名称是" & LayName
    
11.     Dim NewLayerName As String
    
12.     Dim lay As AcadLayer
    
13.     Do
    
14.         NewLayerName = ThisDrawing.Utility.GetString(0, vbCrLf & "输入要转换到的图层名：")
    
15.         Set lay = ThisDrawing.Layers(NewLayerName)
    
16.         If Err Then
    
17.             Err.Clear
    
18.             ThisDrawing.Utility.Prompt vbCrLf & "该名称的图层不存在，请重新输入"
    
19.         Else
    
20.             Exit Do
    
21.         End If
    
22.     Loop
    
23.     Dim FType(0) As Integer
    
24.     Dim FData(0) As Variant
    
25.     FType(0) = 8
    
26.     FData(0) = LayName
    
27.     Dim ss As AcadSelectionSet
    
28.     Set ss = CreatSSet
    
29.     ss.Select acSelectionSetAll, , , FType, FData
    
30.     Dim i As Integer
    
31.     For i = 0 To ss.Count - 1
    
32.         ss(i).Layer = NewLayerName
    
33.     Next i
    
34.    
    
35. End Sub
    
36. 
    
37. Function CreatSSet()
    
38.     Dim ss As AcadSelectionSet
    
39.     On Error Resume Next
    
40.     Set ss = ThisDrawing.SelectionSets.Add("mccad")
    
41.     If Err Then
    
42.         Err.Clear
    
43.         Set ss = ThisDrawing.SelectionSets("mccad")
    
44.         ss.Clear
    
45.     End If
    
46.     Set CreatSSet = ss
    
47. End Function
    

Sub ChgLayer()<br />     On Error Resume Next<br />     Dim Ent As AcadEntity<br />     Dim Pnt As Variant<br />     ThisDrawing.Utility.GetEntity Ent, Pnt, vbCrLf & "选择所要改变图层的对象:"<br />     <br />     Dim LayName As String<br />     LayName = Ent.Layer<br />     ThisDrawing.Utility.Prompt vbCrLf & "你选择转换的图层名称是" & LayName<br />     Dim NewLayerName As String<br />     Dim lay As AcadLayer<br />     Do<br />         NewLayerName = ThisDrawing.Utility.GetString(0, vbCrLf & "输入要转换到的图层名：")<br />         Set lay = ThisDrawing.Layers(NewLayerName)<br />         If Err Then<br />             Err.Clear<br />             ThisDrawing.Utility.Prompt vbCrLf & "该名称的图层不存在，请重新输入"<br />         Else<br />             Exit Do<br />         End If<br />     Loop<br />     Dim FType(0) As Integer<br />     Dim FData(0) As Variant<br />     FType(0) = 8<br />     FData(0) = LayName<br />     Dim ss As AcadSelectionSet<br />     Set ss = CreatSSet<br />     ss.Select acSelectionSetAll, , , FType, FData<br />     Dim i As Integer<br />     For i = 0 To ss.Count - 1<br />         ss(i).Layer = NewLayerName<br />     Next i<br />     <br /> End Sub<br /> <br /> Function CreatSSet()<br />     Dim ss As AcadSelectionSet<br />     On Error Resume Next<br />     Set ss = ThisDrawing.SelectionSets.Add("mccad")<br />     If Err Then<br />         Err.Clear<br />         Set ss = ThisDrawing.SelectionSets("mccad")<br />         ss.Clear<br />     End If<br />     Set CreatSSet = ss<br /> End Function<br />

bluemoon

谢谢斑竹