[编程交流] Dcl对话框到lisp

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;
         }

(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)

; 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_dialog  fname))
(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

(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))
[color="red"]; 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[/color]
(princ)
);| defun |; (vl-load-com) (princ)