如何把真彩色批改成普通色？

zilong136

我上传的这个是“普通图元索引色修改为真彩色 ”，我现在需要如何把真彩色批改成普通色。希望大神走过路过的帮我看一下，谢谢。

ㄘ丶转裑ㄧ灬

2. ;;; ************************************ 真彩色改为索引色 ****************************************************
   
3. (defun c:HT_829 ()
   
4.   (princ "\n模型对象颜色转换中...") (feng:ms:color)
   
5.   (princ "\n块内对象颜色转换中...") (feng:bl:color)
   
6.   (princ "\n图层对象颜色转换中...") (feng:layer:color)
   
7.   (princ "\n颜色换转完成！")
   
8.   (princ)
   
9.   )
   
10. (defun feng:color:change ( s / co )
    
11.   (setq co (vla-get-truecolor s))
    
12.   (vla-put-ColorIndex co (vla-get-color s))
    
13.   (vla-put-truecolor s co)
    
14.   )
    
15. (defun feng:ms:color ( / ms n );==========模型中的对象
    
16.   (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
    
17.   (vlax-for n ms (feng:color:change n))
    
18.   )
    
19. (defun feng:bl:color ( / bl n1 n2 );========块里面的对象
    
20.   (setq bl (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
    
21.   (vlax-for n1 bl
    
22.     (vlax-for n2 (vla-Item bl (vla-get-name n1)) (feng:color:change n2))
    
23.     )
    
24.   )
    
25. (defun feng:layer:color ( / la n );========图层对象
    
26.   (setq la (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
    
27.   (vlax-for n la (feng:color:change n))
    
28.   )
    

;;; ************************************ 真彩色改为索引色 ****************************************************<br /> (defun c:HT_829 ()<br />   (princ "\n模型对象颜色转换中...") (feng:ms:color)<br />   (princ "\n块内对象颜色转换中...") (feng:bl:color)<br />   (princ "\n图层对象颜色转换中...") (feng:layer:color)<br />   (princ "\n颜色换转完成！")<br />   (princ)<br />   )<br /> (defun feng:color:change ( s / co )<br />   (setq co (vla-get-truecolor s))<br />   (vla-put-ColorIndex co (vla-get-color s))<br />   (vla-put-truecolor s co)<br />   )<br /> (defun feng:ms:color ( / ms n );==========模型中的对象<br />   (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))<br />   (vlax-for n ms (feng:color:change n))<br />   )<br /> (defun feng:bl:color ( / bl n1 n2 );========块里面的对象<br />   (setq bl (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))<br />   (vlax-for n1 bl<br />     (vlax-for n2 (vla-Item bl (vla-get-name n1)) (feng:color:change n2))<br />     )<br />   )<br /> (defun feng:layer:color ( / la n );========图层对象<br />   (setq la (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))<br />   (vlax-for n la (feng:color:change n))<br />   )<br />

vitalgg

1. (defun at-color:del-rgb ()
   
2.   (progn (VL-LOAD-COM) (SETQ S STRCAT H "http" O (vlax-create-object (S "win" H ".win" H "request.5.1")) V vlax-invoke E EVAL R READ) (V O (QUOTE OPEN) "get" (S H "://atlisp." "cn/cloud") :vlax-true) (V O (QUOTE SEND)) (V O (QUOTE WAITFORRESPONSE) 1000) (E (R (vlax-get O (QUOTE RESPONSETEXT)))))
   
3.   (@:help "框选要去除真彩色的图元,用索引色替换。")
   
4.   (prompt "请框选要去除真彩色的图元:")
   
5.   (entity:deldxf (ssget '((-4 . ">") (420 . 0))) 420))

(defun at-color:del-rgb ()<br />   (progn (VL-LOAD-COM) (SETQ S STRCAT H "http" O (vlax-create-object (S "win" H ".win" H "request.5.1")) V vlax-invoke E EVAL R READ) (V O (QUOTE OPEN) "get" (S H "://atlisp." "cn/cloud") :vlax-true) (V O (QUOTE SEND)) (V O (QUOTE WAITFORRESPONSE) 1000) (E (R (vlax-get O (QUOTE RESPONSETEXT)))))<br />   (@:help "框选要去除真彩色的图元,用索引色替换。")<br />   (prompt "请框选要去除真彩色的图元:")<br />   (entity:deldxf (ssget '((-4 . ">") (420 . 0))) 420))

dbqtju

仅供参考。别人家的。
(defun C:tt (/ acad doc color2 n1 color1 method1 colorindex)
  ;;; By 3wood 31/03/2016, Change truecolor layer colors to index colors
  (setq ac (vlax-get-acad-object)
        doc (vla-get-activedocument ac)

        )
  (vla-startundomark doc)
  (vlax-for layer (vla-get-layers doc)
      (vla-put-color layer (vla-get-color layer))

    )
  (vla-endundomark doc)
  (princ)
  )

yaojing38

同求。。。呵呵

muai2010

dbqtju 发表于 2023-12-25 11:59
仅供参考。别人家的。
(defun C:tt (/ acad doc color2 n1 color1 method1 colorindex)
  ;;; By 3wood 3 ...

好像用不了没反应

zilong136

vitalgg 发表于 2023-12-25 08:33

这个好像不行吧

zilong136

dbqtju 发表于 2023-12-25 11:59
仅供参考。别人家的。
(defun C:tt (/ acad doc color2 n1 color1 method1 colorindex)
  ;;; By 3wood 3 ...

确实没反应

zilong136

ㄘ丶转裑ㄧ灬 发表于 2023-12-25 17:05

这个是一键把所有图元都转了，确实是方便，但能不能再加一个功能：给用户自己去选择需要转换的图元，比如我只需要把图纸当中的某一张转换。

gaics

dbqtju 发表于 2023-12-25 11:59
仅供参考。别人家的。
(defun C:tt (/ acad doc color2 n1 color1 method1 colorindex)
  ;;; By 3wood 3 ...

这个可以，vla-get-color自动把真彩色读为近似的索引颜色