真彩色转索引色时遇到所有含天正文字属性就出错，直接退CAD
以下lsp是改真彩色为索引色，但只要遇到是天正的文字或标注是真彩色，就直接退出CAD，哪位大老能帮助解决呢？(defun c:toACI ( / i l s )
(if (setq s (ssget "_:L"))
(repeat (setq i (sslength s))
(toACI (entget (ssname s (setq i (1- i)))))
)
)
(command "_.regen")
(princ)
)
(defun toACI ( x / e n )
(entmod (vl-remove-if '(lambda ( x ) (member (car x) '(420 430))) x))
(if (and (= "INSERT" (cdr (assoc 0 x)))
(not (member (setq n (cdr (assoc 2 x))) l))
(setq e (tblobjname "block" n))
(setq l (cons n l))
)
(while (setq e (entnext e)) (toACI (entget e)))
)
)
(princ)
371835653
(defun feng:color:change ( s / co );==========改颜色为索引色
(setq co (vla-get-truecolor s))
(vla-put-ColorIndex co (vla-get-color s))
(vla-put-truecolor s co)
)
(defun feng:ms:color ( / ms n );==========模型中的对象
(setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for n ms (feng:color:change n))
)
(defun feng:bl:color ( / bl n1 n2 );========块里面的对象
(setq bl (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for n1 bl
(vlax-for n2 (vla-Item bl (vla-get-name n1)) (feng:color:change n2))
)
)
(defun feng:layer:color ( / la n );========图层对象
(setq la (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for n la (feng:color:change n))
)
(defun feng:color ()
(princ "\n模型对象颜色换转...") (feng:ms:color)
(princ "\n块内对象颜色换转...") (feng:bl:color)
(princ "\n图层对象颜色换转...") (feng:layer:color)
(princ "\n颜色换转完成！")
)
(feng:color) 有大神的源码http://bbs.mjtd.com/thread-111059-1-1.html，原因是天正的图元不支持组码，只能用Visual LISP调用，而且只能调用部分功能 有大神用Visual LISP编写一个吗？
功能：能把含有天正文字或标注的对象由真彩色转为索引色的功能？可联系我Q：371835653 没那么复杂。用cad自带的命令可以规避掉对天正对象的兼容问题。用组码去改天正对象很容易造成崩溃。
(defun c:00( / s1)
(setq s1(ssget))
(command "change" s1 "" "p" "c" "BYLAYER" "")
) 万不得已，不要用command命令。 @feng582304, 不是要把对象颜色改为随层，而是把对象有真彩色的颜色变为索引色 对象包括CAD对象、实体、块、天正对象等。 感谢feng582304，完美解决问题 感谢feng582304，完美解决问题
页:
[1]
2