[求助]请求完善将所选实体层置为当前层后，实体层的颜色能否随层，谢谢！
<font face="Verdana">;;----------------------<br/>;;将所选实体层置为当前层<br/>;;----------------------<br/>(defun c:cl (/ ent ent_data clay olay)<br/> (setq olay (getvar "clayer"))<br/> (setq ent (car (entsel (strcat "\n选择物体/当前层为<" olay ">:"))))<br/> (if (/= nil ent)<br/> (progn<br/> (setq ent_data (entget ent))<br/> (setq clay (cdr (assoc 8 ent_data)))<br/> (setvar "clayer" clay)<br/> (prompt (strcat "\n成功将图层设为<" clay ">："))<br/> )<br/> )<br/>)<br/></font> <font style="BACKGROUND-COLOR: #ffffff" face="Verdana">(setvar "Cecolor" "ByLayer") ; add this line</font> <p>感谢Anhyhon，实体层的颜色是有红、黄、绿等颜色的，随层后，颜色也有红、黄、绿等颜色，不是单纯的白色，谢谢！</p> ;;----------------------;;将所选实体层置为当前层
;;----------------------
(defun c:cl (/ ent ent_data clay olay)
(setq olay (getvar "clayer"))
(setq ent (car (entsel (strcat "\n选择物体/当前层为<" olay ">:"))))
(if (/= nil ent)
(progn
(setq ent_data (entget ent))
(command "_change" ent "" "_p" "_color" "bylayer" "")
(setq clay (cdr (assoc 8 ent_data)))
(setvar "clayer" clay)
(prompt (strcat "\n成功将图层设为<" clay ">："))
)
)
) 块的改不了 本帖最后由 作者 于 2010-9-18 7:15:31 编辑 <br /><br /> <p><font face="Verdana">;;;用新的组码值替换原值<br/>(defun dxfupd(ent dxfcode newval / elst newlst )<br/> (setq elst(entget ent))</font></p>
<p><font face="Verdana"> (setq newlst(append elst (list (cons dxfcode newval))))</font></p>
<p><font face="Verdana"> (entmod newlst)<br/> (entupd ent))</font></p>
<p><font face="Verdana"></font> </p>
<p><font face="Verdana"></font> </p>
<p><font face="Verdana">(defun c:cl (/ ent ent_data clay olay e blkname blkref elst)<br/> (setq olay (getvar "clayer"))<br/> (setq ent (car (entsel (strcat "\n选择物体 (当前层为<" olay ">) :"))))<br/> (cond<br/>;;; (if ;|(/= nil ent)|; ent<br/> ((not ent) (princ "\n")) ;_无效对象,静默退出<br/> (ent ;_有效对象<br/> (setq ent_data (entget ent))<br/> (setq conlst (assoc 8 ent_data)) ;_实体层关联表<br/> (setq clay (cdr conlst)) ;_所选实体所在的层名<br/> (setvar "clayer" clay) ;_设置当前层<br/> (dxfupd ent 62 256)<br/>;;; (entmod (subst (cons 62 256) (assoc 62 ent_data) ent_data))<br/>;;; (entupd ent)<br/> (if<br/> (equal "INSERT" (cdr (assoc 0 ent_data))) ;_块<br/> (progn<br/>;;; (entmod (subst conlst (assoc 8 ent_data) ent_data))<br/>;;; (entupd ent)<br/> (dxfupd ent 8 clay)<br/> (setq blkname (cdr (assoc 2 ent_data))) ;_块名<br/> (setq blkdef (tblsearch "block" blkname)) ;_块定义</font></p>
<p><font face="Verdana"> (setq e (cdr (assoc -2 blkdef))) ;_块中第一个图元<br/> <br/>;;; (setq elst (append (entget e) (list (cons 62 0)))) ;_块中第一个图元颜色随块<br/>;;;(setq elst (append (entget e)(list (cons 62 256))));_块中第一个图元颜色随层<br/>;;; (entmod (subst (cons 62 0) (assoc 62 elst) elst))<br/>;;; (entupd e)</font></p>
<p><font face="Verdana"> <br/> (dxfupd e 62 0);_等效于上面的代码,随块<br/>;;; (dxfupd e 62 256);_颜色随层</font></p>
<p><font face="Verdana"> (while (and<br/> (setq e (entnext e))<br/> (setq elst (entget e))</font></p>
<p><font face="Verdana"> (/= (cdr (assoc 0 elst)) "SEQEND")<br/> )</font></p>
<p><font face="Verdana">;;; (setq elst (append elst (list (cons 62 0)))) ;_块中图元颜色随块<br/>;;;;;; (setq elst (append elst (list (cons 62 256)))) ;_块中图元颜色随层<br/>;;; (entmod elst)<br/>;;; (entupd e)</font></p>
<p><font face="Verdana"> <br/> (dxfupd e 62 0);_等效于上面的代码,颜色随块<br/>;;; (dxfupd e 62 256);_颜色随层<br/> )<br/> (entupd ent)<br/> )<br/> )<br/> )<br/> )</font></p>
<p>(princ)</p>
<p><font face="Verdana">)<br/></font></p>
<p><font face="Verdana"></font> </p>
<p><font face="Verdana"></font> </p>
<p><font face="Verdana">简单的写了一下,还有另一种方法用vl函数,也很方便,防错功能没有,自已改改吧</p></font> caiqs 发表于 2010-9-17 16:50
本帖最后由 作者 于 2010-9-18 7:15:31 编辑;;;用新的组码值替换原值(defun dxfupd(ent dxfcode newval...
收藏备用
页:
[1]