Dcl对话框到lisp
大家好!我正在尝试为一个小程序制作DSL对话。
DCL:
perfsuff: dialog {
label = "PF";
: boxed_column
{ label = "--< Add >--";
: edit_box
{
label = "Type prefix:";
key = "pre";
value = "";
edit_width = 10;}
: edit_box
{
label = "Type suffix:";
key = "suf";
value = "";
edit_width = 10;}
: spacer
{height = 0.5;}}
ok_cancel;
}
Lisp程序:
(defun c:perfsuff (/ prefiks-txt sufiks-txt spisok znach i)
(initget 1)
(setq prefiks-txt (getstring T "prefix: "))
(initget 1)
(setq sufiks-txt (getstring T "suffix: "))
(princ)
(setq spisok (ssget '((0 . "*text"))))
(setq i 0)
(while (< i (sslength spisok))
(setq znach (entget (ssname spisok i)))
(setq soderzhimoe (cons 1 (strcat prefiks-txt (cdr (assoc 1 znach)) sufiks-txt)))
(setq znach (subst soderzhimoe (assoc 1 znach) znach))
(entmod znach)
(setq i (1+ i))
)
(princ)
)
(c:perfsuff)
我得到了这样的结果:
(defun c:perfsuff (/ prefiks-txt sufiks-txt spisok znach i)
(if (< (setq num (load_dialog "perfsuff")) 0) (exit))
(if (not (new_dialog "perfsuff" num)) (exit))
(action_tile "pre" "(setq rad1 (atof $value))")
(terpri)
(princ prefiks-txt)
(action_tile "suf" "(setq rad1 (atof $value))")
(terpri)
(princ sufiks-txt)
(terpri)
(start_dialog)
(unload_dialog num)
(setq spisok (ssget '((0 . "*text"))))
(setq i 0)
(while (< i (sslength spisok))
(setq znach (entget (ssname spisok i)))
(setq soderzhimoe (cons 1 (strcat prefiks-txt (cdr (assoc 1 znach)) sufiks-txt)))
(setq znach (subst soderzhimoe (assoc 1 znach) znach))
(entmod znach)
(setq i (1+ i))
)
(princ)
)
(c:perfsuff)
但是程序不工作,请告诉我哪里出错了? 几个问题
pre和suf均设置值rad1
prefiks txt是最后一篇文章中的零值
看一看,这是一个多行dcl,有你喜欢的行数。例如,对于代码中的2行,它返回变量Key1 key2作为字符串等
; multi line dcl
; sample code a 2 line example
; By Alan H
; use these two next lines in your code all thats required.
; (if (not AH:getkeys)(load "getvals2"))
;(AH:getkeys (list "Enter prefix " 5 4 "Enter suffix " 5 4 ))
; returns key1 key2 etc
(princ "Getvals2 loaded")
(defun AH:getkeys (INFO / fo fname newlst num x y klist)
; you can hard code a directory if you like for dcl file
;(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(setq fo (open (setq fname "c:\\acadtemp\\getkeys.dcl") "w"))
(write-line "ddgetkey : dialog {" fo)
(write-line " : column {" fo)
(setq num (/ (length info) 3))
(setq x 1)
(repeat num
(setq klist (cons (strcat "key" (rtos x 2 0)) klist))
(setq x (+ 1 x))
)
(setq x 1)
(setq y 1)
(repeat num
(write-line ": edit_box {" fo)
(write-line (strcat " key = "(chr 34) (strcat "key" (rtos y 2 0)) (chr 34) ";") fo)
(write-line (strcat " label = "(chr 34) (nth (- x 1) info) (chr 34) ";") fo)
(write-line (strcat " edit_width = " (rtos (nth x info) 2 0) ";" ) fo)
(write-line (strcat " edit_limit = " (rtos (nth (+ x 1) info) 2 0) ";" ) fo)
(write-line " is_enabled = true;" fo)
(write-line "}" fo)
(write-line "spacer_1 ;" fo)
(setq x (+ x 3))
(setq y (+ y 1))
)
(write-line "}" fo)
(write-line "ok_only;}" fo)
(close fo)
(setq x 1)
(setq outlst '())
(setq dcl_id (load_dialogfname))
(if (not (new_dialog "ddgetkey" dcl_id))
(exit))
(foreach k klist
(action_tile k (strcat "(setq " k " (get_tile \"" k "\"))"))
)
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq action (start_dialog))
(unload_dialog dcl_id)
) ; defun
我也对dcl lisp连接感兴趣,但我一直在从编辑框中获取值:
(defun C:test ( / LstDCL FpathWithFname fileDCL dcl_id dlgRtn Prefix$ Suffix$)
(setq LstDCL
(list
"PrefSuff : dialog"
"{"
"label = \"PF\";"
": boxed_column"
"{"
"label = \"--< Add >--\";"
": edit_box"
"{"
"label = \"Type prefix:\";"
"key = \"pre\";"
"edit_width = 10;"
"}"
": edit_box"
"{"
"label = \"Type suffix:\";"
"key = \"suf\";"
"edit_width = 10;"
"}"
": spacer"
"{height = 0.5;}"
"}"
"ok_cancel;"
"}"
); list
); setq LstDCL
(setq FpathWithFname (vl-filename-mktemp nil nil ".dcl")); studied from LM
(setq fileDCL (open FpathWithFname "w"))
(foreach x LstDCL (write-line x fileDCL))
(close fileDCL)
; Load Dialog
(setq dcl_id (load_dialog FpathWithFname))
(and (not (new_dialog "PrefSuff" dcl_id))(exit))
; UNCLEAR what to do below:
; Set Dialog Initial Settings
(set_tile "pre" Prefix$)
(set_tile "suf" Suffix$)
; Dialog Actions
(action_tile "pre" "(setq Prefix$ $value)")
(action_tile "suf" "(setq Suffix$ $value)")
(if (setq dlgRtn (start_dialog))
(progn
(cond
((= 1 dlgRtn) ; ok was pressed
(alert (vl-princ-to-string Prefix$))
(alert (vl-princ-to-string Suffix$))
(done_dialog)
)
((= 0 dlgRtn) ; cancel was pressed
(done_dialog)
)
)
; Unload Dialog
(unload_dialog dcl_id)
(vl-file-delete FpathWithFname)
); progn
); if
(princ)
);| defun |; (vl-load-com) (princ)
不知道在代码的红色部分到底要做什么,有什么帮助吗? 考虑以下示例:
[颜色=绿色];;前缀/后缀文本-Lee Mac 2016-11-26(defunc:ps(/*error*dch dcl des enx idx pre sel str suf)( 你让事情看起来很简单,我不知道还能说什么。
赞美
非常感谢。
页:
[1]