1291500406 发表于 2019-9-15 01:19:43

VLA&VBA 设置系统背景色

本帖最后由 1291500406 于 2019-9-15 10:05 编辑




调用VLA设置背景
(defun c:bb( / bb)
(setq bb (vla-get-truecolor (vla-get-ActiveLayer(vla-get-activeDocument (vlax-get-acad-object)))))
(if (not(vl-catch-all-apply 'vla-put-ColorIndex (list bb (cdr(car(acad_truecolordlg '(420 . 2686760) nil))))))
(vla-put-graphicswinmodelbackgrndcolor(vla-get-display(vla-get-preferences(vla-get-application (vlax-get-acad-object))))
(+ (* (vla-get-blue bb) 65536) (* (vla-get-green bb) 256)(vla-get-red bb))))(princ))

调用VBA设置背景
(defun c:bb( / bb)(setvar "cmdecho" 0)
(setq bb (vla-get-truecolor (vla-get-ActiveLayer(vla-get-activeDocument (vlax-get-acad-object)))))
(if (not(vl-catch-all-apply 'vla-put-ColorIndex (list bb (cdr(car(acad_truecolordlg '(420 . 2686760) nil))))))
(vl-cmdf "VBASTMT"(strcat "Thisdrawing.application.preferences.Display.GraphicsWinModelBackgrndColor = "
(itoa (+ (* (vla-get-blue bb) 65536) (* (vla-get-green bb) 256)(vla-get-red bb))))))
(setvar "cmdecho" 1)(princ))

masterlong 发表于 2019-9-19 22:00:54

编程当然要耐得住寂寞
要知道很多人来论坛
不是为了学习而是为了收集程序
但总有些人是抱着学习的目的来的
你的代码不就是发给他们看的吗？

另外小小吐槽一句
喜欢不加空格就算了
这个字能大点不
看的眼睛疼
你和论坛某位大咖正相反
他是非常喜欢用铜铃般的字
反正我是从不进他的帖

1291500406 发表于 2019-10-31 09:37:17

happy336 发表于 2019-10-29 22:42
cad2008可以使用，十字光标没有变，全是白色，

(defun c:bb( / bb)
(setq bb (vla-get-truecolor (vla-get-ActiveLayer(vla-get-activeDocument (vlax-get-acad-object)))))
(if (not(vl-catch-all-apply 'vla-put-ColorIndex (list bb (acad_colordlg 3))))
(vla-put-graphicswinmodelbackgrndcolor(vla-get-display(vla-get-preferences(vla-get-application (vlax-get-acad-object))))
(+ (*(vla-get-blue bb)65536) (* (vla-get-green bb) 256)(vla-get-red bb))))(princ))


(defun c:bb1( / bb)
(setq bb (vla-get-truecolor (vla-get-ActiveLayer(vla-get-activeDocument (vlax-get-acad-object)))))
(if (not(vl-catch-all-apply 'vla-put-ColorIndex (list bb (acad_colordlg 3))))
(vla-put-ModelCrosshairColor(vla-get-display(vla-get-preferences(vla-get-application (vlax-get-acad-object))))
(+ (* (vla-get-blue bb) 65536) (* (vla-get-green bb) 256)(* (vla-get-red bb)))))(princ))

lisperado 发表于 2019-10-31 04:23:27

本帖最后由 lisperado 于 2019-10-31 04:29 编辑

RGB次序好像弄反了？
你的是B-G-R?
(* (vla-get-blue bb) 65536) (* (vla-get-green bb) 256)(vla-get-red bb)
应该是B-R-G吧？
(* (vla-get-red bb) 65536) (* (vla-get-green bb) 256)(vla-get-blue bb)

(defun RGB->DEC (r g b)
(apply '+ (mapcar ''((a b) (* a (expt 2 b))) (list r g b) '(16 8 0)))
)

举例：R=100 G=150 B=200
以你的算法=13145700 ?
(+ (* B 65536) (* G 256) R) ？

;应该是6592200 吧？
(RGB->DEC 100 150 200 )
;6592200

qianyi0710 发表于 2019-9-15 12:18:38

{:1_1:}    学习，学习。

1291500406 发表于 2019-9-19 18:56:09

都没人看，没意思，不发表代码了

669423907 发表于 2019-9-19 19:53:51

很有创意啊

happy336 发表于 2019-10-29 22:42:48

cad2008可以使用，十字光标没有变，全是白色，

前生 发表于 2019-10-30 23:43:29

(connand "ucs" "o" pp)
来设定pp点为用户坐标系的原点
ucsorg这个变量是只读的、
请教：
如何同lisp或Vlisp 来设定一个点为用户坐标系的原点

(发新帖要绑定QQ,可惜，我就没QQ);

前生 发表于 2019-10-30 23:45:03

masterlong 发表于 2019-9-19 22:00
编程当然要耐得住寂寞
要知道很多人来论坛
不是为了学习而是为了收集程序


:lol俺也来个大个的字。:P

1291500406 发表于 2019-10-31 09:19:10

本帖最后由 1291500406 于 2019-10-31 09:38 编辑

lisperado 发表于 2019-10-31 04:23
RGB次序好像弄反了？
你的是B-G-R?
(* (vla-get-blue bb) 65536) (* (vla-get-green bb) 256)(vla-get-r ...
cad知道结果，运行一下就知道了
页: [1] 2
查看完整版本: VLA&VBA 设置系统背景色