求不装ET不用VLX等插件，直接用LISP实现图层控制 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第2页

zark 发表于 2011-4-22 19:55:48

(defun lay_ac_ulk (style / oldcmde)
(setq oldcmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (= style "AC")
(progn
   (command "_.layer" "on" "*" "")
   (princ "\n所有图层已开启！")
)
(progn
   (command "_.layer" "U" "*" "")
   (princ "\n所有图层已解锁！")
)
)
(setvar "cmdecho" oldcmde)
)

(defun lay_GC_LCK (STYPE En / CLAY LAY OLDCMDE)
(setq oldcmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq lay (cdr (assoc 8 (entget (car en)))))
(if (= STYPE "GC")
(progn
   (setq clay (getvar "clayer"))
   (if (= lay clay)
(command "_.layer" "off" lay "Y" "")
(command "_.layer" "off" lay "")
   )
)
(progn
   (command "_.layer" "LO" lay "")
   (princ (strcat "\n" lay "层已锁定！"))
)
)
(setvar "cmdecho" oldcmde)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:Layoff (/ EN)
(while (setq en (entsel "\n选择实体所在层:"))
(lay_GC_LCK "GC" EN)
)
(prin1)
)

(defun c:Layon ()
(lay_ac_ulk "AC")
(prin1)
)

(defun c:LayISO (/ ENS I LAY LAY_LST LAY_STR LENG OLDCMDE)
(if (setq ens (ssget))
(progn
   (setq oldcmde (getvar "cmdecho"))
   (setvar "cmdecho" 0)
   (setq leng (sslength ens) i 0)
   (repeat leng
(setq lay (cdr (assoc 8 (entget (ssname ens i)))))
(if (Not (member lay lay_lst))(setq Lay_Lst (cons lay Lay_Lst)))
(setq i (1+ i))
   )
   (setq lay_str "")
   (foreach n Lay_Lst (setq lay_str (strcat lay_str "," n)))
   (setq lay_str (vl-string-trim "," lay_str))
   (command "_.layer" "off" "*" "y" "on" lay_str "")
   (setvar "cmdecho" oldcmde)
)
)
(prin1)
)

(defun c:LayLck (/ EN)
(while (setq en (entsel "\n选择实体所在层:"))
(lay_GC_LCK "LCK" EN)
)
(prin1)
)

(defun c:LayULK ()
(lay_ac_ulk "ULK")
(prin1)
)

(defun c:LAYDEL (/ EN LAY cmde)
(if (setq en (entsel "\n选择实体所在层:"))
(progn
   (setq cmde (getvar "cmdecho"))
   (setvar "cmdecho" 0)
   (setq lay (cdr (assoc 8 (entget (car en)))))
   (command "_.erase" (ssget "x" (list (cons 8 lay))) "")
   (setvar "cmdecho" cmde)
)
)
(prin1)
)

zark 发表于 2011-4-22 19:58:26

骑着蜗牛去把妹 发表于 2011-12-26 00:21:58

LC,    *LAYCUR
LEAD,    *LEADER
LF,    *LAYFRZ
LI,    *LAYISO
LL,    *LAYLCK
LM,    *AI_MOLC
LN,    *LAYON
LO,    *LAYOFF
LT,    *LAYTHW
LU,    *LAYULK
LZ,    *GPS_LAY_FRZ
我喜欢用命令去编写

669423907 发表于 2011-12-26 19:46:57

谢谢 zark 大师提供源码，可以学习一下！

無恒的地盘 发表于 2011-12-27 09:37:22

本帖最后由無恒的地盘于 2011-12-27 20:08 编辑

;;;1、切换到0图层
(defun c:0 nil (command "CLAYER" "0"))

;;;2、将对象物体层置为当前图层
(defun c:FS (/ x )
   (princ "\n将对象物体层置为当前图层")
   (setq x (entsel "\nSelect object whos layer is to be matched: "))
   (command "layer" "S" (cdr (assoc 8 (entget (car x)))) "" ))

;;;3、关闭目标图层
(defun c:t5 (/ x )
   (princ "\n关闭目标图层")
   (setq x (entsel "\nSelect object whos layer is to be OFF: "))
   (command "layer" "set" "0" "OF" (cdr (assoc 8 (entget (car x)))) "" ))

;;;4、冻结目标图层
(defun c:t1 (/ x )(princ "\n冻结目标图层")
   (setq x (entsel "\nSelect object whos layer is to be FROZEN: "))
   (command "layer" "T" "0" "s" "0" "")
   (command "layer" "F" (cdr (assoc 8 (entget (car x)))) "" ))

;;;5、锁定目标图层
(defun c:t7 (/ x )
   (princ "\n锁定目标图层")
   (setq x (entsel "\nSelect object whos layer is to be LOCK: "))
   (command "layer" "LO" (cdr (assoc 8 (entget (car x)))) "" ))

;;;6、将当前锁定图层解锁，并锁定其它全部图层
(defun c:t77(/ x )
   (princ "\n将当前锁定图层解锁，并锁定其它全部图层")
   (setq x (entsel "\nSelect object whos layer only will be displayed: "))
   (command "layer" "LO" "*" "U" (cdr (assoc 8 (entget (car x)))) "" ))

;;;7、将对象物体层改为0图层
(DEFUN C:SF ()
   (princ "\n将对象物体层改为0图层")
   (SETQ CH (SSGET))
   (command "setvar" "highlight" "1")
   (SETQ LA2 (GETVAR "CLAYER"))
   (COMMAND "CHANGE" CH "" "PROP" "LAYER" LA2 "")
   (COMMAND "CHANGE" CH "" "PROP" "COLOR" "BYL" "LT" "BYLAYER" "")
   (command "setvar" "highlight" "1"))

;;;8、将对象物体层更换到目标图层
(DEFUN C:SZ ()
   (princ "\n将对象物体层更换到目标图层")
   (SETQ CH (SSGET))
   (SETQ TARGET (CAR (ENTSEL "\nSelect object on desired layer: ")))
   (SETQ NA2 (ENTGET    TARGET))
   (SETQ LA2 (CDR (ASSOC 8 NA2)))
   (COMMAND "CHANGE" CH "" "PROP" "LAYER" LA2 ""))

;;;9、
(defun c:oooo nil (command "layer" "Z" "*" ""))

;;;10、解冻全部图层
(defun c:t2 nil (princ "\n解冻全部图层")(command "layer" "T" "*" ""))

;;;11、除当前图层，冻结全部图层
(defun c:t11 nil (princ "\n除当前图层，冻结全部图层")(command "layer" "F" "*" ""))

;;;12、锁定全部图层
(defun c:t8 nil (princ "\n锁定全部图层")(command "layer" "LO" "*" ""))

;;;13、解锁全部图层
(defun c:t9 nil (princ "\n解锁全部图层")(command "layer" "U" "*" ""))

;;;14、除当前图层，关闭全部图层
(defun c:t55 nil (princ "\n除当前图层，关闭全部图层")(command "LAYER" "OFF" "*" "" ""))

;;;15、打开全部图层
(defun c:t6 nil (princ "\n打开全部图层")(command "LAYER" "ON" "*" ""))

;;;16、除当前锁定图层外，关闭冻锁定其它全部图层
(defun c:XU nil (princ "\n除当前锁定图层外，关闭冻锁定其它全部图层")(command "LAYER" "LO" "*" "F" "*" "OFF" "*" "" ""))

;;;17、打开解冻解锁全部图层
(defun c:UX nil (princ "\n打开解冻解锁全部图层")(command "LAYER" "U" "*" "T" "*" "ON" "*" "" ""))

;;;18、在视口冻结图层
(defun C:tf ( / Ent Entlist Lay)
   (setq Ent (car (entsel "\nSelect an entity on the layer to be frozen: "))

注册发表于 2013-7-21 20:19:54

;图层全开
(defun c:qk ()
(command "-layer" "on" "*" "")
(princ "\n：所有图层已开")
)

;图层全关
(defun c:qg ()
(command "-layer" "OFF" "*" "y" "")
(princ "\n：所有图层已关")
)

;关闭指定图层
(defun c:gtc ()
(setq mc (getstring "输入图层名："))
(command "-layer" "off" mc"")
(princ "\n：指定图层已关")
)

;打开指定图层
(defun c:ktc ()
(setq mc (getstring "输入图层名："))
(command "-layer" "on" mc"")
(princ "\n：指定图层已开")
)

;关闭对象所在图层
(defun c:gtc1 ()
(setq ss (ssget))
(setq cnt (sslength ss))
(setq cnt1 (- 1 cnt))
(setq c 0)
(while (<= c cnt1)
(setq en (ssname ss c))
(setq lay (cdr (assoc 8 (entget en))))
(if (= lay (getvar "clayer"))
   (command "-layer" "off" lay "y" "")
   (progn
(command "-layer" "off" lay "")
   )
)
(setq c (+ 1 c))
)
(princ)
)

;只开实体所在图层
(defun c:ktc1 ()
(setq ss (ssget))
(setq cnt (sslength ss))
(setq cnt1 (- 1 cnt))
(command "-layer" "OFF" "*" "y" "")
(setq c 0)
(while (<= c cnt1)
(setq en (ssname ss c))
(setq lay (cdr (assoc 8 (entget en))))
(command "-layer" "on" lay "")
(command "-layer" "s" lay "")
(setq c (+ 1 c))
)
(princ)
)

取自明经，借花献佛

注册发表于 2013-7-21 20:22:36

再献花一次

;;; 解锁层
(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)
)

趣意人生 发表于 2021-2-14 16:04:16

谢谢各位的分享！

页: 1 [2]

明经CAD社区's Archiver