zhuquanmao 发表于 2013-4-7 09:57:50

图层控制程序 源码 网上已经很多了 这个自己弄的


;;; 解锁层
(defun c:Lay_ul (/ ssa index n entity)
(setvar "cmdecho" 0)
(setq ssa (ssget))
(setq n (sslength ssa))
(setq index (- n 1))
(repeat n
    (setq entity (ssname ssa index))
    (command "-layer" "u" (cdr (assoc 8 (entget entity))) "")
    (setq index (1- index))
)
(princ)
)
;;; 锁定层
(defun c:Lay_ll (/ ssa index n entity)
(setvar "cmdecho" 0)
(princ "\n请注意：被选中的对象所在层将被锁定")
(setq ssa (ssget))
(setq n (sslength ssa))
(setq index (- n 1))
(repeat n
    (setq entity (ssname ssa index))
    (command "-layer" "lo" (cdr (assoc 8 (entget entity))) "")
    (setq index (1- index))
)
(princ)
)
;;; 解冻层
(defun c:Lay_tl (/ ss)
(setvar "cmdecho" 0)
(command "-layer" "t" "*" "")
(princ)
)
;;; 锁住其他层
(defun c:Lay_lo (/ ssa index n entity chklay)
(prompt "锁定其他层")
(setvar "cmdecho" 0)
(command "-layer" "lo" "*" "")
(setq ssa (ssget))
(setq n (sslength ssa))
(setq index (- n 1))
(repeat n
    (setq entity (ssname ssa index))
    (command "-layer" "u" (cdr (assoc 8 (entget entity))) "")
    (command "-layer" "u" (strcat (cdr (assoc 8 (entget entity))) "*") "")
    (setq index (1- index))
)
(princ)
)
;;; 解锁所有层
(defun c:Lay_ua (/ ss)
(setvar "cmdecho" 0)
(command "-layer" "u" "*" "")
(princ)
)
;;; 打开指定层
(defun c:Lay_olcc (/ cname)
(setvar "cmdecho" 0)
(command "-layer" "off" "*" "y" "")
(setq cname (getstring "\n输入想打开的层: "))
(command "-layer" "on" (strcat "*" cname "*") "")
(princ)
)
;;; 打开所有层
(defun c:Lay_ol (/ ss)
(setvar "cmdecho" 0)
(command "-layer" "on" "*" "")
(princ)
)
;;; 设当前层为embed
(defun c:Lay_ef (/)
(setvar "cmdecho" 0)
(setq chklay (tblsearch "layer" "EMBED"))
(if (= chklay nil)
    (progn
      (command "-LAYER" "N" "EMBED" "C" "151" "EMBED" "")
      (command "-LAYER" "s" "EMBED" "")
    )
    (command "-LAYER" "s" "EMBED" "")
)
(princ)
)

2548572928 发表于 2024-4-29 12:31:48

感谢楼主分享源码

2548572928 发表于 2024-3-29 09:19:04

感谢楼主无私分享 :victory::victory:

wowan1314 发表于 2013-4-7 10:37:08

支持。

spp_wall 发表于 2013-4-7 10:37:58

好像都没有删除指定图层

仲文玉 发表于 2013-4-7 10:39:41

支持下源码，

zhuquanmao 发表于 2013-4-7 12:28:11

本帖最后由 zhuquanmao 于 2013-4-7 12:32 编辑

spp_wall 发表于 2013-4-7 10:37 http://bbs.mjtd.com/static/image/common/back.gif
好像都没有删除指定图层

网上网友作品
(defun c:Lay_scc (/ et ln lay_name ss li)
(princ "\n清除指定图层内的实体")
(setq li (entsel "\n请选择指定图层内的任何一个实体<回车直接输入层名>:"))
(if li
    (progn                               ; 选择一个实体
      (setq et (entget (nth 0 li)))
      (setq lay_name (cdr (assoc 8 et)))
    )
    (progn                               ; 直接输入层名，理想的办法是采用列表

      (princ "输入层名:")
      (while (= ln nil)
      (setq lay_name (getstring))
      (setq ln (cdr (assoc 2 (tblnext "layer" t))))
      (while (and
               ln
               (/= ln "%")
               )
          (if (/= ln lay_name)
            (setq ln (cdr (assoc 2 (tblnext "layer"))))
            (setq ln "%")               ; 如指定的图层名已存在，则设“%”标?
                                       ; ?
          )
      )
      (if (/= ln "%")                     ; 错误处理
          (princ "指定的图层不存在，请重新输入:")
      )
      )

    )
)
(setq ss (ssget "X" (list (cons 8 lay_name)))) ; 构造选择集
(command "-layer" "u" lay_name "")   ; 图层解锁
(command "ERASE" ss "")               ; 清除所有实体
(princ "\n清除完毕！")
(princ)
)

【KAIXIN】 发表于 2013-4-7 13:48:50

支持，用VLA来实现，代码很简洁
http://bbs.mjtd.com/thread-99208-1-1.html

zhuquanmao 发表于 2013-4-7 13:50:26

【KAIXIN】 发表于 2013-4-7 13:48 static/image/common/back.gif
支持，用VLA来实现，代码很简洁
http://bbs.mjtd.com/thread-99208-1-1.html

偶不会vla 只会简单的lisp啊

开1心 发表于 2013-7-13 16:49:05

CAD2006好像都用不了啊~奇怪中~~

品茗新秀 发表于 2013-7-13 17:19:15

看一下,有欠缺,如选中图中图元,再选要将此图元进入后选的图元的图层中,

sicky111 发表于 2013-8-5 16:20:25

对照一下，看跟我的有没有什么不同。
页: [1] 2
查看完整版本: 图层控制程序 源码 网上已经很多了 这个自己弄的