【K:Cecolor4ACI】获取当前色的ACI近似色

kucha007

2. (defun K:Cecolor4ACI (/ LayObj CurCol AciCol LayLck TmpEn)
   
3.     (setq LayObj (vlax-ename->vla-object (tblobjname "LAYER" (getvar "CLAYER"))));当前层
   
4.     (setq CurCol (getvar "CECOLOR"))
   
5.     (cond
   
6.         ((<= 1 (atoi CurCol) 255)(setq AciCol (atoi CurCol)));1~255
   
7.         ((= "BYBLOCK" CurCol) (setq AciCol 7));随块0
   
8.         ((= "BYLAYER" CurCol) (setq AciCol (vla-get-Color LayObj)));随层取层色
   
9.         (T
   
10.             (setq LayLck Nil)
    
11.             (if (eq (vla-get-lock LayObj) :vlax-true);锁定了
    
12.                 (progn
    
13.                   (setq LayLck T)
    
14.                   (vla-put-lock LayObj :vlax-false);解锁
    
15.                 )
    
16.             );临时解锁当前层
    
17.             (setq TmpEn (entmakeX (list '(0 . "POINT") (cons 10 '(0.0 0.0 0.0)))));创建临时实体
    
18.             (setq AciCol (cdr (assoc 62 (entget TmpEn))))
    
19.             (if TmpEn (vla-Delete (vlax-ename->vla-object TmpEn)));删除临时实体
    
20.             (if LayLck (vla-put-lock LayObj :vlax-false));重新锁定当前层
    
21.         );RGB或其它
    
22.     )
    
23.     AciCol
    
24. )

(defun K:Cecolor4ACI (/ LayObj CurCol AciCol LayLck TmpEn)<br />     (setq LayObj (vlax-ename->vla-object (tblobjname "LAYER" (getvar "CLAYER"))));当前层<br />     (setq CurCol (getvar "CECOLOR"))<br />     (cond<br />         ((<= 1 (atoi CurCol) 255)(setq AciCol (atoi CurCol)));1~255<br />         ((= "BYBLOCK" CurCol) (setq AciCol 7));随块0<br />         ((= "BYLAYER" CurCol) (setq AciCol (vla-get-Color LayObj)));随层取层色<br />         (T <br />             (setq LayLck Nil)<br />             (if (eq (vla-get-lock LayObj) :vlax-true);锁定了<br />                 (progn <br />                   (setq LayLck T)<br />                   (vla-put-lock LayObj :vlax-false);解锁<br />                 )<br />             );临时解锁当前层<br />             (setq TmpEn (entmakeX (list '(0 . "POINT") (cons 10 '(0.0 0.0 0.0)))));创建临时实体<br />             (setq AciCol (cdr (assoc 62 (entget TmpEn))))<br />             (if TmpEn (vla-Delete (vlax-ename->vla-object TmpEn)));删除临时实体<br />             (if LayLck (vla-put-lock LayObj :vlax-false));重新锁定当前层<br />         );RGB或其它<br />     )<br />     AciCol<br /> )

主要用途:

1. (grdraw (getpoint) (getpoint) (K:Cecolor4ACI));UCS

(grdraw (getpoint) (getpoint) (K:Cecolor4ACI));UCS

magicheno

感谢大佬分享

atone

感谢分享，赞

czb203

感谢大佬分享