求点选一图元，在该图元上的图层被选择，然后颜色变为红色

crazylsp

块也能变色？

【KAIXIN】

KX-Put-Lay-Col 在KAIXIN通用函数里面

chenbh2

好,非常的好!

疯球

谢谢分享！！！！！！！！！！！！！

尘缘一生

chlh_jd 发表于 2012-12-24 14:47
这个功能实际上不难，希望楼主能多自己研究下。
提供纯lisp的方法如下：

选图元改其所在图层的颜色，可为任意色。。。

1. ;;;选图元改层色
   
2. (defun c:test  (/ en ent lay layent a c-num)
   
3.   (command "_.undo" "_begin")
   
4.   (setq en (car (entsel "\n选择要修改图层颜色的代表对象:")));_选择对象
   
5.   (setq ent (entget en));_对象图元表
   
6.   (setq lay (cdr (assoc 8 ent)));_获取对象图层名
   
7.   (setq layent (entget (tblobjname "LAYER" lay)));_获取图层图元表
   
8.   (if (setq a (assoc 340 layent)) ;_如果存在真彩色
   
9.     (setq layent (vl-remove a layent)) ;_删除真彩色表
   
10.   )
    
11.   (setq c_num(acad_colordlg 1 t))
    
12.   (setq layent (subst (cons 62 c_num) (assoc 62 layent) layent));_图层颜色改为目标色
    
13.   (entmod layent);_更新图层
    
14.   (entupd (cdr (assoc -1 layent)))
    
15.   (command "_.undo" "_end")
    
16.   (princ)
    
17. )

;;;选图元改层色<br /> (defun c:test  (/ en ent lay layent a c-num)<br />   (command "_.undo" "_begin")<br />   (setq en (car (entsel "\n选择要修改图层颜色的代表对象:")));_选择对象<br />   (setq ent (entget en));_对象图元表<br />   (setq lay (cdr (assoc 8 ent)));_获取对象图层名<br />   (setq layent (entget (tblobjname "LAYER" lay)));_获取图层图元表<br />   (if (setq a (assoc 340 layent)) ;_如果存在真彩色<br />     (setq layent (vl-remove a layent)) ;_删除真彩色表<br />   )<br />   (setq c_num(acad_colordlg 1 t))<br />   (setq layent (subst (cons 62 c_num) (assoc 62 layent) layent));_图层颜色改为目标色<br />   (entmod layent);_更新图层<br />   (entupd (cdr (assoc -1 layent)))<br />   (command "_.undo" "_end")<br />   (princ)<br /> )

zyhandw

zyhandw 发表于 2012-12-24 10:28
这个应该很简单吧，先试试这个是不是你要的！命令为lay2red

@尘缘一生 不好意思，好多年的小程序了，找不到源码了

yanchao316

尘缘一生 发表于 2018-6-29 10:33
选图元改其所在图层的颜色，可为任意色。。。