社区 › AutoLISP/Visual LISP 编程技术 › 如何更改全图指定颜色号为新的颜色号

sctw 发表于 2021-3-14 23:28:44

如何更改全图指定颜色号为新的颜色号

经常有的图里设有（255号索引色），或者（255，255，255号色的真彩色），打印的时候就不能把这些白色打出来，这些颜色有的是在嵌套块里或外部参照里，如何快速查找出这两个颜色并换成指定色，例如7号笔。谢谢

caoyin 发表于 2021-3-14 23:28:45

本帖最后由 caoyin 于 2021-3-15 02:17 编辑

;;; 将图形中所有颜色为 255 或 255,255,255 的对象改为指定ACI颜色
(defun C:TT (/ COL TC CM)
(setq *AX:ACAD* (vlax-get-acad-object)
      *AX:DOC*(vla-get-ActiveDocument *AX:ACAD*)
)
(if (setq COL (acad_colordlg 7))
    (vlax-for BLK (vla-get-Blocks *AX:DOC*)
      (vlax-for OBJ BLK
      (setq TC (vlax-get OBJ 'TrueColor)
            CM (vlax-get TC 'ColorMethod)
      )
      (if (or (and (= CM 195)
                     (= (vlax-get TC 'ColorIndex) 255)
                )
                (and (= CM 194)
                     (= (vlax-get TC 'BookName) "")
                     (= (vla-get-red TC)
                        (vla-get-green TC)
                        (vla-get-blue TC)
                        255
                     )
                )
            )
          (vlax-put OBJ 'Color COL)
      )
      )
    )
)
(princ)
)

sctw 发表于 2021-3-14 23:46:53

需要更改到单行或多行文字、标注，天正对象等

sctw 发表于 2021-3-18 00:33:44

试了下暂时没发现问题，非常感谢，还有点小问题，看能否补充下：
1、如果对象是随层，图层的颜色如果设置成了255或真彩色255，255，255的话，程序是否也会改图层的颜色呢？如果不能，可否加上改图层。
2、程序能否先判断文件是否存在图层或对象有255色，没有就不用改，如果有则进行改成指定颜色。因为程序运行时图大的话还是有点慢的。
麻烦版主了哈

caoyin 发表于 2021-3-18 01:40:50

本帖最后由 caoyin 于 2021-3-18 02:13 编辑

sctw 发表于 2021-3-18 00:33
试了下暂时没发现问题，非常感谢，还有点小问题，看能否补充下：
1、如果对象是随层，图层的颜色如果设置 ...
二楼的程序是遍历所有图元(包括块的子图元)，对于图形对象数量多的图形，速度肯定会慢
把代码功能分开:
TT------二楼的代码，遍历所有对象
TT1-----只修改套嵌对象
TT2-----只修改一级层面的对象
;;;--------------------------------------------------------------------------------------------
;;; 检索图块中套嵌对象（不检索一级层面的对象），将颜色为 255 或 255,255,255 的对象改为指定颜色，
(defun C:TT1 (/ COL TC CM)
(setq *AX:ACAD* (vlax-get-acad-object)
      *AX:DOC*(vla-get-ActiveDocument *AX:ACAD*)
)
(if (setq COL (acad_colordlg 7))
    (vlax-for BLK (vla-get-Blocks *AX:DOC*)
      (vlax-for OBJ BLK
      (if (= (vlax-get BLK 'IsLayout) 0)
          (progn
            (setq TC (vlax-get OBJ 'TrueColor)
                CM (vlax-get TC 'ColorMethod)
            )
            (if (or (and (= CM 195)
                         (= (vlax-get TC 'ColorIndex) 255)
                  )
                  (and (= CM 194)
                         (= (vlax-get TC 'BookName) "")
                         (= (vla-get-red TC)
                            (vla-get-green TC)
                            (vla-get-blue TC)
                            255
                         )
                  )
                )
            (vlax-put OBJ 'Color COL)
            )
          )
      )
      )
    )
)
(princ)
)
;;; ---------------------------------------------------------------------------------------------
;;; 下面的程序只选择一级层面的对象(不包含套嵌对象)，速度会很快。
;;; 将图形中所有颜色为 255 或 255,255,255 的对象 (不包含图块子图元) 改为颜色 7
(defun C:TT2 (/ X LAY X1)
(while (setq X (tblnext "LAYER" (not X)))
    (setq LAY (cdr (assoc 2 X))
          X   (entget (tblobjname "LAYER" LAY))
    )
    (if (= (cdr (assoc 420 X)) 16777215)
      (setq X1 (vl-remove '(420 . 16777215) X))
      (if (= (cdr (assoc 62 X)) 255)
      (setq X1 (subst '(62 . 7) '(62 . 255) X))
      )
    )
    (if X1
      (progn
      (princ (strcat "\n图层“" LAY "”的颜色被更改为 7。"))
      (entmod X1)
      (setq X1 nil)
      )
    )
)
(if (setq SS (ssget "_X" '((-4 . "<OR") (62 . 255) (420 . 16777215) (-4 . "OR>"))))
    (progn
      (setq X1 (sslength SS))
      (princ (strcat "\n" (itoa X1) " 个对象颜色被修改为 7。"))
      (repeat X1
      (setq X1 (1- X1)
            X(entget (ssname SS X1))
            X(vl-remove '(420 . 16777215) X)
            X(subst '(62 . 7) '(62 . 255) X)
      )
      (entmod X)
      )
    )
    (princ "未找到颜色为 255 或 255,255,255 的对象。")
)
(princ)
)

查看完整版本: 如何更改全图指定颜色号为新的颜色号