求图层变换程序

zxwknight822

请问高手。

图层建好后 有 1 2 3 4 5 6.....

在选择对象后通过键盘输入1 2 3 4 6 ....中任意一个数字被选对象就变到数字相对应的图层中去了。

鬼魔

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=60228

mingvictor

我这里有一些你看看！

(defun c:00 () (command "LAYER""S""00"""))

(defun c:01 () (command "LAYER""S""01"""))
(defun c:02() (command "LAYER""S""02"""))
(defun c:03 () (command "LAYER""S""03"""))
(defun c:04 () (command "LAYER""S""04"""))
(defun c:05 () (command "LAYER""S""05"""))
(defun c:1 () (command "LAYER""S""1"""))
(defun c:11 () (command "LAYER""T""11""S""11"""))
(defun c:12 () (command "LAYER""S""12"""))
(defun c:13 () (command "LAYER""S""13"""))
(defun c:14 () (command "LAYER""S""14"""))
(defun c:15() (command "LAYER""S""15"""))
(defun c:16 () (command "LAYER""S""16"""))
(defun c:17 () (command "LAYER""S""17"""))
(defun c:18 () (command "LAYER""S""18"""))
(defun c:2 () (command "LAYER""S""2"""))
(defun c:3 () (command "LAYER""S""3"""))
(defun c:5 () (command "LAYER""S""5"""))
(defun c:51 () (command "LAYER""S""51"""))
(defun c:52 () (command "LAYER""S""52"""))
(defun c:53 () (command "LAYER""S""53"""))
(defun c:54 () (command "LAYER""S""54"""))
(defun c:55 () (command "LAYER""S""55"""))
(defun c:56 () (command "LAYER""S""56"""))
(defun c:57 () (command "LAYER""S""57"""))
(defun c:58 () (command "LAYER""S""58"""))
(defun c:6 () (command "LAYER""S""6"""))
(defun c:7 () (command "LAYER""S""7"""))
(defun c:71 () (command "LAYER""S""71"""))
(defun c:72 () (command "LAYER""S""72"""))
(defun c:73 () (command "LAYER""S""73"""))
(defun c:75 () (command "LAYER""S""75"""))
(defun c:76 () (command "LAYER""S""76"""))
(defun c:77 () (command "LAYER""S""77"""))
(defun c:78 () (command "LAYER""S""78"""))
(defun c:8 () (command "LAYER""S""8"""))

phonexi

都是lsp

来个vba的

Sub Example_layer()

    Dim layerobj As AcadLayer
    Dim obj As AcadEntity
    Dim pt As Variant
  

   '创建图层
    For i = 1 To 10
        Set layerobj = ThisDrawing.Layers.Add(CStr(i))
    Next i
   
    On Error Resume Next
    ThisDrawing.Utility.GetEntity obj, pt, "选择对象:"
    If Err <> 0 Then
        Exit Sub
    End If
   
    Dim LayerName As String
    Do
        LayerName = ThisDrawing.Utility.GetString(5, "输入图层名:")
   
        For i = 0 To Layers.Count - 1
            If UCase(Layers.Item(i).Name) = UCase(LayerName) Then
                obj.Layer = LayerName
                Exit Do
            End If
        Next i
       
        ThisDrawing.Utility.Prompt "输入的图层不存在，重新输入！" & vbCr
    Loop

End Sub