[LISP]如何获取图元的颜色索引号

blue123 · 发表于 2005-11-21 19:40:00

其实我想编一个专门用来删同一色图元的程式，现在搞定了，谢谢二位，ZZXXQQ和飞哥。程式如下：

(DEFUN C:GETCL(/ S1)
(SETQ S1 (ENTSEL "\nSelect a object 选择一个实体 :"))
(if (not (ASSOC 62 (ENTGET (CAR S1)))) (setq ss (ssget "x" '((62 . 256))))
(setq ss (ssget "x"(list (ASSOC 62 (ENTGET (CAR S1))))))
)
(command "erase" ss "")
)

ZZXXQQ · 发表于 2005-11-21 21:41:00

(SSGET "X" '((62 . 256)))只是选择了全部颜色随图层的实体，有可能误删除不同颜色的实体。

blue123 · 发表于 2005-11-22 21:11:00

请教该如何解决呢？

ZZXXQQ · 发表于 2005-11-23 21:39:00

(DEFUN C:GETCL(/ S1)
(SETQ S1 (ENTSEL "\nSelect a object 选择一个实体 :"))
(if (not (ASSOC 62 (ENTGET (CAR S1))))
(setq ss (ssget "x" (LIST (ASSOC 8 (ENTGET (CAR S1))) (CONS 62 256))))
(setq ss (ssget "x" (list (ASSOC 62 (ENTGET (CAR S1))))))
)
(command "erase" ss "")
)

thtanhao · 发表于 2005-11-25 09:06:00

;以前和大家讨论的结果

;;; 图层的颜色
;;; 返回层的颜色
(defun th1-get-color (laname / la1 la col)
(setq la (cdr (assoc 2 (tblnext "layer" t))))
(while (/= la laname)
    (setq la1 (tblnext "layer" nil)
   la (cdr (assoc 2 la1))
   col (cdr (assoc 62 la1))
    )
)
(princ "\n颜色为 : ")
col
)
;;; ==================================================================
;;; 返回实体颜色
(defun th2-get-color (ename / ent col)
(setq ent (entget ename))
(or
    (setq col (cdr (assoc 62 ent)))
    (setq col (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 ent))))))
)
col
)
(defun th3-get-color (ename / ent col)
(setq ent (entget ename))
(cond
    ((setq col (cdr (assoc 62 ent))))
    ((setq col (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 ent)))))))
)
)
;;; ==================================================================
;;; 求实体所在层和颜色,返回(层名颜色)
(defun th1-get-layandcol (ename / b col doc lay layobj)
(vl-load-com)
(setq b (vlax-ename->vla-object ename))
(setq lay (vla-get-layer b))
(setq col (vla-get-color b))
(if (= col 256)
    (progn
      (setq doc (vla-get-activedocument (vlax-get-acad-object)))
      (setq layobj (vla-item (vla-get-layers doc) lay))
      (setq col (vla-get-color layobj))
    )
)
(list lay col)
)
(defun th2-get-layandcol (ename / ent col)
(setq ent (entget ename))
(setq lay (cdr (assoc 8 ent)))
(cond
    ((setq col (cdr (assoc 62 ent))))
    ((setq col (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 ent)))))))
)
(list lay col)
)
(defun th3-get-layandcol (ename / ent col)
(setq ent (entget ename))
(setq lay (cdr (assoc 8 ent)))
(cond
    ((setq col (cdr (assoc 62 ent))))
    ((setq col (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 ent)))))))
)
(if (cdr (assoc 62 ent))
    (list lay col)
    (list lay col "bylayer")
)
)

账号		自动登录	找回密码
密码			注册