VLA&VBA 设置系统背景色

1291500406

调用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

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

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

1291500406

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

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)

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

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

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

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

qianyi0710

    学习，学习。

1291500406

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

669423907

很有创意啊

happy336

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

前生

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

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

前生

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

俺也来个大个的字。:P

1291500406

lisperado 发表于 2019-10-31 04:23
RGB次序好像弄反了？
你的是B-G-R?
(* (vla-get-blue bb) 65536) (* (vla-get-green bb) 256)(vla-get-r ...

cad知道结果，运行一下就知道了