sathalex 发表于 2022-7-5 16:57:31

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)
但是程序不工作,请告诉我哪里出错了?

BIGAL 发表于 2022-7-5 17:16:34

几个问题
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

Grrr 发表于 2022-7-5 17:25:48

我也对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 发表于 2022-7-5 17:35:08

考虑以下示例:
[颜色=绿色];;前缀/后缀文本-Lee Mac 2016-11-26(defunc:ps(/*error*dch dcl des enx idx pre sel str suf)(

Grrr 发表于 2022-7-5 17:51:04

你让事情看起来很简单,我不知道还能说什么。
赞美

Lee Mac 发表于 2022-7-5 17:59:31

 
非常感谢。
页: [1]
查看完整版本: Dcl对话框到lisp