dear sir,
reduce money
沙发，支持楼主！
学习~~
自贡黄明儒 发表于 2012-8-8 09:08 static/image/common/back.gif
(setvar "shortcutmenu" 11);必须有这一句,右键回车时才能出现菜单选择项
(initget "Single Horizonal V ...
又学到东西了
版主GU_xl都加分了，说明是好程序。大家还不动手，更待何时？
好东东，顶一个
虽然有点贵，但是还是有点用的，修改修改还是可以更好
我也贴一个。改了下，只设置几个自己常用的变量或者设置
(defun C:SETV (/ sysvartodcl dcltoprvar prvartosysvar sv wipeouttog1 imageframetog1 cmdechotog1 ucsicontog1 filediatog1 traynotifytog1 experttog1 visretaintog1 mirrtexttog1 explmodetog1 osnapztog1 osoptionstog1 strin fname fn dclid lin qr)
;;取得当前系统变量值，并在对话框中设置勾选模式
(defun SysVarToDCL ()
;;第一列
;;命令提示回显
(if (= (getvar "cmdecho") 0)
(set_tile "cmdechotog" "0")
(set_tile "cmdechotog" "1")
)
;;UCS图标
(if (>= (getvar "ucsicon") 1)
(set_tile "ucsicontog" "1")
(set_tile "ucsicontog" "0")
)
;;对话框模式
(if (= (getvar "filedia") 1)
(set_tile "filediatog" "1")
(set_tile "filediatog" "0")
)
;;服务通知
(if (= (getvar "traynotify") 1)
(set_tile "traynotifytog" "1")
(set_tile "traynotifytog" "0")
)
;;“重生成”通知
(if (= (getvar "expert") 1)
(set_tile "experttog" "0")
(set_tile "experttog" "1")
)
;;存储参照特性
(if (= (getvar "visretain") 1)
(set_tile "visretaintog" "1")
(set_tile "visretaintog" "0")
)
;;第二列
;;保持文字方向
(if (= (getvar "mirrtext") 0)
(set_tile "mirrtexttog" "1") ;_保持，勾选
(set_tile "mirrtexttog" "0")
)
;;炸开不等比图块
(if (= (getvar "explmode") 1)
(set_tile "explmodetog" "1")
(set_tile "explmodetog" "0")
)
;;遮罩边框
(if (or (= wipeouttog1 nil) (= wipeouttog1 "1"))
(set_tile "wipeouttog" "1")
(set_tile "wipeouttog" "0")
)
;;图像边框
(if (or (= imageframetog1 nil) (= imageframetog1 "1"))
(set_tile "imageframetog" "1")
(set_tile "imageframetog" "0")
)
;;Z轴值替换
(if (= (getvar "osnapz") 1)
(set_tile "osnapztog" "1")
(set_tile "osnapztog" "0")
)
;;捕捉忽略填充
(if (>= (atof (getvar "acadver")) 17.1);_判断cad版本是否是cad2008及其以上的
(if (or (= (getvar "osoptions") 1) (= (getvar "osoptions") 3))
(set_tile "osoptionstog" "1")
(set_tile "osoptionstog" "0")
)
(if (= (getvar "osnaphatch") 1)
(set_tile "osoptionstog" "1")
(set_tile "osoptionstog" "0")
)
)
)
;;;获取对话框中的设置到全局变量
(defun DCLToPrVar ()
(setq cmdechotog1 (get_tile "cmdechotog"))
(setq ucsicontog1 (get_tile "ucsicontog"))
(setq filediatog1 (get_tile "filediatog"))
(setq traynotifytog1 (get_tile "traynotifytog"))
(setq experttog1 (get_tile "experttog"))
(setq visretaintog1 (get_tile "visretaintog"))
(setq mirrtexttog1 (get_tile "mirrtexttog"))
(setq explmodetog1 (get_tile "explmodetog"))
(setq wipeouttog1 (get_tile "wipeouttog"))
(setq imageframetog1 (get_tile "imageframetog"))
(setq osnapztog1 (get_tile "osnapztog"))
(setq osoptionstog1 (get_tile "osoptionstog"))
)
;;根据全局变量设置系统变量及其他设置
(defun PrVarToSysVar ()
(if (equal cmdechotog1 "1")
(setvar "cmdecho" 1)
(setvar "cmdecho" 0)
)
(if (equal ucsicontog1 "1")
(setvar "ucsicon" 1)
(setvar "ucsicon" 0)
)
(if (equal filediatog1 "1")
(setvar "filedia" 1)
(setvar "filedia" 0)
)
(if (equal traynotifytog1 "1")
(setvar "traynotify" 1)
(setvar "traynotify" 0)
)
(if (equal experttog1 "1")
(setvar "expert" 0)
(setvar "expert" 1)
)
(if (equal visretaintog1 "1")
(setvar "visretain" 1)
(setvar "visretain" 0)
)
(if (equal mirrtexttog1 "1")
(setvar "mirrtext" 0)
(setvar "mirrtext" 1)
)
(if (equal explmodetog1 "1")
(setvar "explmode" 1)
(setvar "explmode" 0)
)
(if (equal wipeouttog1 "1")
(vl-cmdf "WIPEOUT" "F" "ON") ;_ 关闭遮罩线
(vl-cmdf "WIPEOUT" "F" "OFF") ;_ 打开遮罩线
)
(if (equal imageframetog1 "1")
(vl-cmdf "_imageframe" "1") ;_ 打开图像边框
(vl-cmdf "_imageframe" "0") ;_ 关闭图像边框
)
(if (equal osnapztog1 "1")
(setvar "osnapz" 1)
(setvar "osnapz" 0)
)
(if (equal osoptionstog1 "1")
(setvar "osoptions" 1)
(setvar "osoptions" 0)
)
)
;;主程序
(initget "S") ;关键字“S”及空格
(setq strin (getstring "\n [常用变量设置S]<回车执行系统变量初始化>："))
(if (or (equal strin "S") (equal strin "s"))
(progn
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq fn (open fname "w"))
(write-line "MyOptionDCL : dialog { " fn)
(write-line " label = \"常用变量设置\";" fn)
(write-line " :row{" fn)
(write-line " :column{" fn)
(write-line " :toggle{label=\"命令提示回显\";key=\"cmdechotog\";}" fn)
(write-line " :toggle{label=\"显示UCS图标\";key=\"ucsicontog\";}" fn)
(write-line " :toggle{label=\"对话框模式\";key=\"filediatog\";}" fn)
(write-line " :toggle{label=\"服务通知\";key=\"traynotifytog\";} " fn)
(write-line " :toggle{label=\"“重生成”通知\";key=\"experttog\";}" fn)
(write-line " :toggle{label=\"存储参照特性\";key=\"visretaintog\";}" fn)
(write-line " }" fn)
(write-line " :column{" fn)
(write-line " :toggle{label=\"保持文字方向\";key=\"mirrtexttog\";}" fn)
(write-line " :toggle{label=\"炸开不等比图块\";key=\"explmodetog\";}" fn)
(write-line " :toggle{label=\"遮罩边框\";key=\"wipeouttog\";}" fn)
(write-line " :toggle{label=\"图像边框\";key=\"imageframetog\";}" fn)
(write-line " :toggle{label=\"Z轴值替换\";key=\"osnapztog\";}" fn)
(write-line " :toggle{label=\"捕捉忽略填充\";key=\"osoptionstog\";}" fn)
(write-line " }" fn)
(write-line " }" fn)
(write-line " ok_only;" fn)
(write-line "}" fn)
(close fn)
(setq fn (open fname "r"))
(setq dclid (load_dialog fname))
(while
(or (eq (substr (setq lin
(vl-string-right-trim
"\" fn)"
(vl-string-left-trim "(write-line \"" (read-line fn))
)
)
1
2
)
"//"
)
(eq (substr lin 1 (vl-string-search " " lin)) "")
(not (eq (substr lin (+ (vl-string-search " " lin) 1) 9)
" : dialog"
)
)
)
)
(new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
(SysVarToDCL)
(action_tile "accept" "(DCLToPrVar)(done_dialog 1)")
(if (= (start_dialog) 1)
(PrVarToSysVar)
)
(unload_dialog dclid)
(close fn)
(vl-file-delete fname)
)
(progn
(initget "Y N") ;_关键字“Y N”及空格
(setq QR (getstring "\n确认系统变量初始化？[是(Yes)/否(No)]<否(No)>"))
(if (or (equal QR "Y") (equal QR "y"))
(progn
(setvar "gridmode" 0)
(C:CSH) ;_系统变量初始化
)
)
))
(princ)
)
呵呵，厉害楼主