求图层变换程序

zxwknight822 发表于 2007-6-28 13:09:00

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

鬼魔发表于 2007-6-28 15:22:00

<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=60228">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=60228</a>

mingvictor 发表于 2007-10-7 20:34:00

我这里有一些你看看！(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 发表于 2007-10-8 11:33:00

都是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     LoopEnd Sub

页: [1]

明经CAD社区's Archiver

求图层变换程序