求单独的图层控制 lisp 程序
<P>那位大侠有编写好了的可以在ACAD14-2005可单独加载的LISP程序可以完成以下功能：</P><P></P>
<P>:AutoCAD里图层控制常用命令:<BR>------------------------------------------<BR>Layer</P>
<P>Layoff Layon<BR>Layfrz Laythw<BR>Laylck Layulk</P>
<P>Layiso</P>
<P>Ai_molc Laycur Laymch</P>
<P>Layoff Layon<BR>可以把对象所在的层关掉 或 开起所有层</P>
<P>Layfrz Laythw<BR>可以把对象所在的层冻掉 或 解冻所有层<BR>Laylck Layulk<BR>可以把对象所在的层锁掉 或 把对象所在的层解锁</P>
<P>Layiso<BR>可以把一些对象所在的一个或几个层留下（即关掉其他所有的层）</P>
<P>Ai_molc<BR>可以把指定的一个对象所在的层设为当前层<BR>Laycur<BR>可以把指定的一些对象移至当前层<BR>Laymch<BR>可以把指定的一些对象的层改到另一指定对象所在的层</P>
<P>谢谢了</P> 这些全是简单程序，自己学个入门功夫就可以写出来，何必求人呢？ <P>;;---图层函数定义------------------------<BR>(defun gpslayer (/ ss n index entity la old) <BR> (setq ss (ssget))<BR> (setq n (sslength ss)) <BR> (setq index (- n 1)) <BR> (repeat n <BR> (setq entity (ssname ss index)) ;物体名称<BR> (setq la (cdr (assoc 8 (entget entity)))) ;图层名称<BR> (if (= old nil)(setq old la)(setq old (strcat old "," la)))<BR> (setq index (1- index))<BR> ) ;end repeat<BR> old<BR>)</P>
<P>;****************************************************显示+解锁+解冻全部层<BR>(defun c:gps_showall ()<BR> (command "layer" "on" "*" "")<BR> (command "layer" "thaw" "*" "")<BR> (command "layer" "u" "*" "")<BR> (princ))</P>
<P>;;;[全部显示]<BR>(defun c:gps_layonall ()<BR> (command "layer" "on" "*" "")<BR> (princ))<BR>;;;[全部解锁]<BR>(defun c:gps_unlock ()<BR> (command "layer" "u" "*" "")<BR> (princ))<BR>;;;[全部解冻]<BR>(defun c:gps_unthaw ()<BR> (command "layer" "thaw" "*" "")<BR> (princ)<BR>)<BR>;***[图层关闭]layoff<BR>(defun c:gps_layoff (/ ss ct len cl la )<BR> (setvar "cmdecho" 0)<BR> (prompt"\n请选择要关闭的图层上的对象")<BR> (setq ss (ssget))<BR> (if (and ss (sslength ss) 0)<BR> (progn <BR> (setq ct 0 len (sslength ss) cl (getvar "clayer"))<BR> (command ".Layer")<BR> (while (< ct len)<BR> (setq la (cdr (assoc 8 (entget (ssname ss ct)))))<BR> (if (/= cl la)(command "off" la) (command "off" la "y"));end of if<BR> ;;(if (= old nil)(setq old la)(setq old (strcat old "," la))) ;;old关闭图层列表<BR> (setq ct (1+ ct))<BR> );end of while<BR> (command"")<BR> );end of progn<BR> );end of if <BR> (princ)<BR>)<BR>;***[图层锁定]LAYLCK<BR>(defun c:gps_laylck (/ gpslay )<BR> (setvar "cmdecho" 0)<BR> (prompt"\n请选择要锁定的图层上的对象")<BR> (setq gpslay (gpslayer))<BR> (command ".Layer" "Lo" gpslay "" )<BR> (princ)<BR> )<BR>;***[图层解锁]ulck<BR>(defun c:gps_layulck (/ gpslay )<BR> (setvar "cmdecho" 0)<BR> (prompt"\n请选择要解锁的图层上的对象")<BR> (setq gpslay (gpslayer))<BR> (command ".Layer" "U" gpslay "" )<BR> (princ)<BR> )<BR>;***[图层冻结]<BR>(defun c:gps_laythaw (/ gpslay )<BR> (setvar "cmdecho" 0)<BR> (prompt"\n请选择要冻结的图层上的对象")<BR> (setq gpslay (gpslayer))<BR> (command ".Layer" "F" gpslay "" )<BR> (princ)<BR> )<BR>;***将所选对象的层变为当前层<BR>(defun c:gps_laycur( / e n gpslay)<BR> (setvar "cmdecho" 0)<BR> (setq e (car (entsel "请选择对象，该对象所在层将变为当前层:")))<BR> (if e (progn <BR> (setq e (entget e))<BR> (setq n (cdr (assoc 8 e)))<BR> (command"layer" "set" n "")<BR> );end progn<BR> );end if<BR> (princ)<BR> )<BR> <BR>;;[隔离图层]layiso<BR>;;[解除隔离]layuniso<BR>;;[未选锁定]<BR>(defun c:gps_layunsloc( / e n gpslay)<BR> (setvar "cmdecho" 0)<BR> (prompt"\n请选择要解冻的图层上的对象")<BR> (setq gpslay (gpslayer))<BR> (command ".Layer" "lo" "*" "u" gpslay "" )<BR> (princ)<BR> )<BR></P>
<P> </P> 原来我还没入门呢!唉, 革命尚未成功, 同志们仍需努力! <p>呵呵</p><p>xshrimp</p><p>你常来这里吗？~</p><p></p> 感谢<strong><font face="Verdana" color="#61b713">xshrimp的源码。</font></strong>
页:
[1]