Sub aa()
Dim s As String
On Error Resume Next
Dim la As AcadLayer
s = InputBox("请输入图层名称")
Set la = ThisDrawing.Layers("0")
ThisDrawing.Layers(s).Lock = False
ThisDrawing.Layers(s).Freeze = False
For i = 1 To ThisDrawing.ModelSpace.Count
If ThisDrawing.ModelSpace(i - 1).Layer = s Then
ThisDrawing.ModelSpace(i - 1).Delete
End If
Next
ThisDrawing.ActiveLayer = la
ThisDrawing.Layers(s).Delete
ThisDrawing.SaveAs "d:/hello.dwg"
Application.Quit
End Sub