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

zilong136 · 发表于 2023-12-25 03:51

本帖最后由 zilong136 于 2023-12-29 03:22 编辑

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

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

;;; ************************************ 真彩色改为索引色 ****************************************************
(defun c:HT_829 ()
(princ "\n模型对象颜色转换中...") (feng:ms:color)
(princ "\n块内对象颜色转换中...") (feng:bl:color)
(princ "\n图层对象颜色转换中...") (feng:layer:color)
(princ "\n颜色换转完成！")
(princ)
)
(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 c:HT_829 () 
  (princ "\n模型对象颜色转换中...") (feng:ms:color) 
  (princ "\n块内对象颜色转换中...") (feng:bl:color) 
  (princ "\n图层对象颜色转换中...") (feng:layer:color) 
  (princ "\n颜色换转完成！") 
  (princ) 
  ) 
(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)) 
  )

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

(defun at-color:del-rgb ()
(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)))))
(@:help "框选要去除真彩色的图元,用索引色替换。")
(prompt "请框选要去除真彩色的图元:")
(entity:deldxf (ssget '((-4 . ">") (420 . 0))) 420))

dbqtju · 发表于 2023-12-25 11:59

仅供参考。别人家的。
(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 · 发表于 2023-12-25 12:06

同求。。。呵呵

muai2010 · 发表于 2023-12-25 15:44

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

好像用不了没反应

zilong136 · 发表于 2023-12-26 00:53

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

这个好像不行吧

zilong136 · 发表于 2023-12-26 00:59

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

确实没反应

zilong136 · 发表于 2023-12-26 01:07

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

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

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

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

本帖子中包含更多资源

点评