快速切换Autocad颜色Sch
该程序允许您在AutoCAD中应用配色方案（如WinAmp）设置存储在xml文件中。
Dwgru\u color\u模式。xml文件的位置应支持AutoCAD。
由2个命令定义：
ACS-应用所选方案
GetShema-打印在当前配色方案的文本框片段设置xml文件中。
颜色sheme。拉链 非常有创意的弗拉基米尔，我喜欢这个主意 谢谢VVA。这是一个新的想法来放松眼睛和一些ex如何处理XML文件^ 谢谢你这个好主意。 感谢您的关注。这段代码是为了演示动态对话的形成，并将数据存储在xml文件中。 嗨，VVA，很有趣的是，我不擅长XML结构，所以我将其修改为注册表存储，以制作一个新的脏版本，希望您不要介意。
我想问一下，当双击一个列表框中的“项目”时，如何使用$Reason 4来应用，就像选择应用按钮一样。互联网上的一些例子不足以让我的IQ分数很低^^
;;-------------------=={ Color sheme }==------------------------;;
;; ;;
;;Change the color scheme in AutoCAD (like WinAmp) ;;
;;the data of color schemes for AutoCAD stored in xml file ;;
;;--------------------------------------------------------------;;
;; Author: Vladimir Azarko (VVA), Copyright © 2011 - www.dwg.ru ;;
;; Some of updates : Ketxu (Nguyen Son Tung ;;
;;--------------------------------------------------------------;;
;; Special thanks ;;
;; gomer - idea ;;
;; Vov.ka - xml parser ;;
;; Alexandr Rivilis - GetOleColor, GerRGB ;;
;;--------------------------------------------------------------;;
;; ALL RIGHTS REMOVED ;;
;;--------------------------------------------------------------;;
;;--------------------------------------------------------------;;
(defun c:ACS()
(setq appRegPath "HKEY_CURRENT_USER\\Software\\ACS\\")
(defun ACS:WK (key)(vl-registry-write (setq rt (strcat appRegPath key))) rt)
(defun ACS:WV (path key val)(vl-registry-write (ACS:WK path) key (vl-princ-to-string val))) ;Reg write
(defun ACS:W_Shema (x) (ACS:WV (car x) nil (cadr x)))
(defun ACS:RV (path key)(read(vl-registry-read (strcat appRegPath path) key))) ;Reg read
(defun ACS:Apply_Shema (themes)(mapcar '(lambda(x y) (set_shema (eval x)y)) lstFunc_Put (ACS:RV themes nil)))
(defun ACS:Insert_Shema (sName lstColor) ;Insert Shema to Reg
(or sName (setq sName (strcat "Themes - " (menucmd (strcat "m=$(edtime,"(rtos (getvar "DATE") 2",DD:MO:YY - HH:MM:SS)")))))
(ACS:W_Shema
(cons sName
(list
(cond
(lstColor)
(list
((lambda (display)
(mapcar '(lambda (x)
(GetRGB (vlax-variant-value
(vlax-variant-change-type
(eval (list x display))
vlax-vblong
) ;_ end of vlax-variant-change-type
) ;_ end of vlax-variant-value
) ;_ end of GetRGB
) ;_ end of lambda
(list
'vla-get-graphicswinmodelbackgrndcolor
'vla-get-modelcrosshaircolor
'vla-get-textwinbackgrndcolor
'vla-get-textwintextcolor
'vla-get-graphicswinlayoutbackgrndcolor
'vla-get-layoutcrosshaircolor) ;_ end of list
) ;_ end of mapcar
) ;_ end of lambda
(vla-get-display
(vla-get-preferences (vlax-get-acad-object))
) ;_ end of vla-get-display
)
)
)
)
)
)
)
;;; A. Rivilis
(defun GetOleColor (r g b) (+ r (lsh g(lsh b 16)))
(defun GetRGB (Olecolor)
(list
(logand Olecolor 255)
;; R
(logand (lsh Olecolor - 255)
;; G
(logand (lsh Olecolor -16) 255)
;; B
) ;_ end of list
) ;_ end of defun
(defun set_shema (func lst)
;;; func - function like 'vla-put-ModelCrosshairColor
;;; lst - RGB list (R G B) or (255 0 234)
(func
(vla-get-display
(vla-get-preferences (vlax-get-acad-object))
) ;_ end of vla-get-display
(vlax-make-variant (apply 'GetOleColor lst) vlax-vblong)
) ;_ end of func
) ;_ end of defun
;VVA : i change sth to learn about action in DCL
(defun mydcl (zagl info-list / fl ret dcl_id)
(vl-load-com)
(or zagl (setq zagl "Select"))
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w")
ud (lambda()
(start_list "info" 3)
(mapcar 'add_list (setq info-list (acad_strlsort(vl-registry-descendentsappRegPath))))
(end_list))
)
(mapcar
'(lambda (x) (write-line x ret))
(list "mip_msg : dialog { "
(strcat "label=\"" zagl "\";")
" :list_box {"
"alignment=top ;width=51 ;allow_accept = true;"
"tabs = \"16 32\";tab_truncate = true;"
(if (> (length info-list) 26)
"height= 26 ;"
(strcat "height= " (itoa (+ 3 (length info-list))) ";")
) ;_ end of if
"is_tab_stop = false ;"
"key = \"info\";}"
" :row {"
" :button {"
"label=\" OK \";"
"key = \"Accept\";"
"is_cancel = true;}"
" :button {"
"label=\"Apply\";"
"key = \"kApply\";}"
" :button {"
"label=\"Insert\";"
"key = \"kInsert\";}"
" :button {"
"label=\"Delete\";"
"key = \"kDelete\";}"
" :button {"
"label=\"Cancel \";"
"key = \"kCancel\";}"
"}}"
) ;_ end of list
) ;_ end of mapcar
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
) ;_ end of and
(progn
(start_list "info")
(mapcar 'add_list info-list)
(end_list)
(set_tile "info" "0")
(setq ret (car info-list))
(action_tile
"info"
"(setq ret (nth (atoi $value) info-list))"
) ;_ end of action_tile
(action_tile
"kCancel"
"(progn(setq ret nil)(done_dialog 0))"
) ;_ end of action_tile
(action_tile "Accept" "(done_dialog 1)")
(action_tile "kApply" "(ACS:Apply_Shema (nth (atoi(get_tile \"info\")) info-list))")
(action_tile "kInsert" "(ACS:Insert_Shema nil nil)(ud)")
(action_tile "kDelete" "(vl-registry-delete (strcat appRegPath (nth (atoi(get_tile \"info\")) info-list)))(ud)")
(start_dialog)
) ;_ end of progn
) ;_ end of if
(unload_dialog dcl_id)
(vl-file-delete fl)
ret)
(setq lstFunc_Put
'(
vla-put-GraphicsWinModelBackgrndColor
vla-put-ModelCrosshairColor
vla-put-TextWinBackgrndColor
vla-put-TextWinTextColor
vla-put-GraphicsWinLayoutBackgrndColor
vla-put-LayoutCrosshairColor
))
(cond
((not (vl-registry-descendentsappRegPath)) ;First run
(mapcar 'ACS:W_Shema
(list
(cons"Classic" (list (list '(0 0 0) '(255 255 255)'(255 255 255) '(0 0 0) '(255 255 255) '(0 0 0))))
(cons"Negative" (list (list '(255 255 255) '(0 0 0) '(0 0 0) '(255 255 255) '(255 255 255) '(0 0 0))))
(cons"Winter" (list (list '(214 214 214) '(0 0 0) '(255 255 255) '(0 0 0) '(255 255 255) '(0 0 0))))
(cons"The Matrix" (list (list '(0 0 0) '(0 255 0) '(0 0 0) '(0 255 0) '(255 255 255) '(0 0 0))))
(cons"Ocean" (list (list '(0 0 0) '(255 255255) '(0 173 173)'(255 255 255) '(255 255 255) '(0 0 0))))
(cons"Pascal" (list (list '(0 0 0) '(255 255 255) '(0 0 255) '(255 255 0) '(255 255 255) '(0 0 0))))
(cons"Sakura" (list (list '(0 0 0) '(246 223 233) '(246 223 233) '(120 70 44) '(255 255 255) '(0 0 0))))
(cons"Deep dive" (list (list '(38 40 48) '(127 159255) '(38 40 48) '(127 159 255) '(51 102 255) '(0 0 0))))
)
)
)
)
(if (setq item (mydcl "Select Shema to Apply :" (acad_strlsort(vl-registry-descendentsappRegPath))))
(ACS:Apply_Shema item)
)
)
只要阅读这些帖子
双击列表框
正在运行的对话框
AutoLISP宝箱
在dcl列表框中双击 谢谢你，VVA，它很有用，我知道该做什么^ 非常有趣的VVA。
干杯
页:
[1]