求单独的图层控制 lisp 程序

wy168

那位大侠有编写好了的可以在ACAD14-2005可单独加载的LISP程序可以完成以下功能：

:AutoCAD里图层控制常用命令:
------------------------------------------
Layer

Layoff Layon
Layfrz Laythw
Laylck Layulk

Layiso

Ai_molc Laycur Laymch

Layoff Layon
可以把对象所在的层关掉 或 开起所有层

Layfrz Laythw
可以把对象所在的层冻掉 或 解冻所有层
Laylck Layulk
可以把对象所在的层锁掉 或 把对象所在的层解锁

Layiso
可以把一些对象所在的一个或几个层留下（即关掉其他所有的层）

Ai_molc
可以把指定的一个对象所在的层设为当前层
Laycur
可以把指定的一些对象移至当前层
Laymch
可以把指定的一些对象的层改到另一指定对象所在的层

谢谢了

yedajiang

这些全是简单程序，自己学个入门功夫就可以写出来，何必求人呢？

xshrimp

;;---图层函数定义------------------------
(defun  gpslayer (/ ss n index entity la old)   
  (setq ss (ssget))
  (setq n (sslength ss))
  (setq index (- n 1))
  (repeat n
        (setq entity (ssname ss index)) ;物体名称
        (setq la (cdr (assoc 8 (entget entity)))) ;图层名称
        (if (= old nil)(setq old la)(setq old (strcat old "," la)))
        (setq index (1- index))
        ) ;end repeat
 old
)

;****************************************************显示+解锁+解冻全部层
(defun c:gps_showall ()
        (command "layer" "on" "*" "")
        (command "layer" "thaw" "*" "")
        (command "layer" "u" "*" "")
    (princ))

;;;[全部显示]
(defun c:gps_layonall ()
 (command "layer" "on" "*" "")
 (princ))
;;;[全部解锁]
(defun c:gps_unlock ()
        (command "layer" "u" "*" "")
        (princ))
;;;[全部解冻]
(defun c:gps_unthaw ()
        (command "layer" "thaw" "*" "")
    (princ)
)
;***[图层关闭]layoff
(defun  c:gps_layoff (/ ss ct len cl la )
  (setvar "cmdecho" 0)
  (prompt"\n请选择要关闭的图层上的对象")
  (setq ss (ssget))
  (if (and ss (sslength ss) 0)
    (progn
     (setq ct 0 len (sslength ss) cl (getvar "clayer"))
     (command ".Layer")
     (while (< ct len)
         (setq la (cdr (assoc 8 (entget (ssname ss ct)))))
         (if (/= cl la)(command "off" la) (command "off" la "y"));end of if
          ;;(if (= old nil)(setq old la)(setq old (strcat old "," la))) ;;old关闭图层列表
         (setq ct (1+ ct))
       );end of while
       (command"")
     );end of progn
  );end of if
 (princ)
)
;***[图层锁定]LAYLCK
(defun c:gps_laylck (/ gpslay )
 (setvar "cmdecho" 0)
 (prompt"\n请选择要锁定的图层上的对象")
 (setq gpslay (gpslayer))
 (command ".Layer" "Lo" gpslay "" )
 (princ)
 )
;***[图层解锁]ulck
(defun c:gps_layulck (/ gpslay )
 (setvar "cmdecho" 0)
 (prompt"\n请选择要解锁的图层上的对象")
 (setq gpslay (gpslayer))
 (command ".Layer" "U" gpslay "" )
 (princ)
 )
;***[图层冻结]
(defun c:gps_laythaw (/ gpslay )
 (setvar "cmdecho" 0)
 (prompt"\n请选择要冻结的图层上的对象")
 (setq gpslay (gpslayer))
 (command ".Layer" "F" gpslay "" )
 (princ)
 )
;***将所选对象的层变为当前层
(defun c:gps_laycur( / e n gpslay)
 (setvar "cmdecho" 0)
      (setq e (car (entsel "请选择对象，该对象所在层将变为当前层:")))
      (if e (progn
  (setq e (entget e))
  (setq n (cdr (assoc 8 e)))
  (command"layer" "set" n "")
      );end progn
 );end if
  (princ)
  )
  
;;[隔离图层]layiso
;;[解除隔离]layuniso
;;[未选锁定]
(defun c:gps_layunsloc( / e n gpslay)
 (setvar "cmdecho" 0)
 (prompt"\n请选择要解冻的图层上的对象")
 (setq gpslay (gpslayer))
 (command ".Layer" "lo" "*" "u" gpslay "" )
 (princ)
 )

 

fly_902

原来我还没入门呢!  唉, 革命尚未成功, 同志们仍需努力!

abcxyz0517

呵呵

xshrimp

你常来这里吗？~

arthwon

感谢xshrimp的源码。