- 积分
- 27201
- 明经币
- 个
- 注册时间
- 2006-2-25
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2021-3-18 01:40:50
|
显示全部楼层
本帖最后由 caoyin 于 2021-3-18 02:13 编辑
二楼的程序是遍历所有图元(包括块的子图元),对于图形对象数量多的图形,速度肯定会慢
把代码功能分开:
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)
)
|
|