将本作业指定颜色的所有直线改变为另一种颜色的命令
www.dimcax.com
将本作业指定颜色的所有直线改变为另一种颜色的命令
运用图元表
供初学者学习
d
;;;;;;;;;;;;;
;;;定义将本作业指定颜色的所有直线改变为另一种颜色的命令
(defun c:ccolor(/ oldcolor newcolor new_cl e el old_cl layname laytab laycolor)
(setq oldcolor (getint "\n输入待改变的颜色号:"))
(setq newcolor (getint "\n输入新的颜色号:"))
(setq new_cl (cons 62 newcolor));构造新颜色子表
(setq e (entnext));得到第一个图元名
(while e;当图元的名字有定义时
(setq el (entget e));得到一个图元表
(if(= "line" (cdr (assoc 0 el)));判断该图元是否是直线
(progn ;是直线
(setq old_cl (assoc 62 el));得到老颜色子表(点对)
(if(null old_cl);判断颜色子表是否为空
(progn;没有颜色子表,即颜色随层
(setq layname (cdr (assoc 8 el)));得到图元名
(setq laytab (tblsearch "layer" layname));得到指定图层名的图层表
(setq laycolor (cdr (assoc 62 laytab)));得到图层的颜色号
(if(= oldcolor laycolor);判断图层的颜色是否与待改的颜色相同
(progn;相同,该层颜色为被改颜色
(setq el (cons new_cl el));插入颜色子表
(entmod el);更新图形数据库的el图元表
)))
(progn;有颜色子表,即颜色独立于图层
(if(= oldcolor (cdr old_cl));判断图元的颜色是否与待改的颜色相同
(progn;相同,该层颜色为被改色
(setq el (subst new_cl old_cl el));颜色替换
(entmod el);更新图形数据库的el图元表
))))))
(setq e (entnext e));令e等于e的下一个图元的名字
))
d
可以,考虑比较周到。但建议不要搜索整个图形数据库,好多块内的直线,虽然对它处理了,但最终还是改不了。为减少运行时间,最好用ssget,(ssget "x" '((0 . "line")))
d
谢谢指教
d
如何改成支持所有实体?(包括块内的)
也就是图中所有的颜色不随层的实体都可以改为想要的。比如原来所有不随层且颜色为150的都改为5,不管它是什么东西,只要打印的都改
打印需要。
d