Lisp弹出窗口乐筑天下 - Powered by Discuz! Archiver

Roy_043 发表于 2022-7-5 17:32:05

我喜欢你的建议，罗伊，
如果您不介意的话，我已经将DCL放入lsp文件中以便于使用：
dcl_test : dialog {
label = "Test commands dialog";
spacer;
: button {
key = "C1";
label = "Command1";
}
spacer;
: button {
key = "C2";
label = "Command2";
}
spacer;
: button {
key = "C3";
label = "Command3";
}
spacer;
cancel_button;
}

Grrr 发表于 2022-7-5 17:36:54

我对罗伊的建议太兴奋了，所以我写了一个副标题：

(defun C:test ( / *error* fp fdcl dcl_id ret cmd )

(defun *error* (m)
(and dcl_id (unload_dialog dcl_id)) (and fp (vl-file-delete fp))
(and m (print m))
(princ)
); defun *error*

(setq fp (vl-filename-mktemp "tempfile.dcl"))
(setq fdcl (open fp "w"))
(write-line
"
dcl_test
: dialog
{
label = \"Test commands dialog\";
spacer;
: button
{
key = \"C1\";
label = \"Command1\";
}
spacer;
: button
{
key = \"C2\";
label = \"Command2\";
}
spacer;
: button
{
key = \"C3\";
label = \"Command3\";
}
spacer;
cancel_button;
}
"
fdcl
)
(close fdcl)
(setq dcl_id (load_dialog fp))
(if (new_dialog "dcl_test" dcl_id)
(progn
(action_tile "C1" "(setq cmd \"C1\") (done_dialog 1)")
(action_tile "C2" "(setq cmd \"C2\") (done_dialog 1)")
(action_tile "C3" "(setq cmd \"C3\") (done_dialog 1)")
(setq ret (start_dialog)) ; If Cancel is pressed ret will be 0.
(unload_dialog dcl_id) (and fp (vl-file-delete fp)) ; unload and delete the tempfile
)
(progn (alert "Can't load the dialog!") (and fp (vl-file-delete fp)))
)
(if (= 1 ret)
(cond
( (= "C1" cmd) (alert "Please enter your Command 1:") )
( (= "C2" cmd) (alert "Please enter your Command 2:") )
( (= "C3" cmd) (alert "Please enter your Command 3:") )
)
)
(princ)
)

用法：

(defun ButtonPromptBOX ( dlglabel StrCommandsLst / *error* fp fdcl dcl_id dlgRtn rtn )

(defun *error* (m)
(and dcl_id (unload_dialog dcl_id)) (and fp (vl-file-delete fp))
(and m (print m))
(princ)
); defun *error*

(setq fp (vl-filename-mktemp "tempfile.dcl"))
(setq fdcl (open fp "w"))
(write-line
(strcat
" dcl_test : dialog { label = \"" dlglabel "\"; "
(apply 'strcat
(mapcar
'(lambda (x)
(strcat
"
spacer;
: button
{ key = \"" (car x) "\"; label = \"" (cdr x) "\"; }
"
)
)
StrCommandsLst
)
)
" spacer; cancel_button; } "
); strcat
fdcl
); write-line
(close fdcl)
(setq dcl_id (load_dialog fp))
(if (new_dialog "dcl_test" dcl_id)
(progn
(foreach x (mapcar 'car StrCommandsLst)
(action_tile x (strcat "(setq rtn \"" x "\") (done_dialog 1)"))
)
(setq dlgRtn (start_dialog)) ; If Cancel is pressed dlgRtn will be 0.
(unload_dialog dcl_id) (and fp (vl-file-delete fp)) ; unload and delete the tempfile
)
(progn (alert "Can't load the dialog!") (and fp (vl-file-delete fp)))
)
(if (= 1 dlgRtn) rtn)
);| defun ButtonPromptBOX |; (or vlax-get-acad-object (vl-load-com)) (princ)

对不起，我的邮件有两个。

Grrr 发表于 2022-7-5 17:40:18

您可以有一个子函数，根据需要创建任意多行dcl，无论是1行还是10行。只需从一个简单的列表（setq lst（list“Item 1”“Item 2”））开始，这将是一个2行dcl示例。

这是一篇关于同一件事的老帖子http://www.cadtutor.net/forum/showthread.php?92520-多行DCL自动代码生成器&突出显示=多

有一个新的帖子将试图找到它相当肯定大卫贝瑟尔张贴了一个完整的例程。

BIGAL 发表于 2022-7-5 17:42:04

; Test function of "ButtonPromptBOX"
(defun C:test ( / StrCommandsLst r )
(setq StrCommandsLst ; assoc List of ( <key> . <label> )
(list
(cons "key1" "Command1")
(cons "key2" "Command2")
(cons "key3" "Command3")
(cons "key4" "Command4")
(cons "key5" "Command5")
(cons "key6" "Command6")
(cons "key7" "Command7")
(cons "key8" "Command8")
(cons "key9" "Command9")
(cons "key10" "Command10")
)
)

(if (setq r (ButtonPromptBOX "Prompt for a command dialog" StrCommandsLst))
(alert (strcat "Please enter your " (cdr (assoc r StrCommandsLst)) ""))
)
(princ)
); defun C:test

pBe 发表于 2022-7-5 17:44:46

哇！
这就是我一直在寻找的。但是为什么单击按钮不会自动拾取与按钮关联的lisp。。。。。例如，单击按钮1应激活加法lisp

(defun C:test( / cmd dcl ret)
(setq dcl (load_dialog "test.DCL")) ; Load DCL.
(if (new_dialog "dcl_test" dcl)
(progn
   (action_tile "C1" "(done_dialog 1)")
(action_tile "C2" "(done_dialog 2)")
(action_tile "C3" "(done_dialog 3)")
(setq ret (start_dialog)) ; If Cancel is pressed ret will be 0.
(unload_dialog dcl)
)
(alert "Can't load the dialog!")
)
(cond
( (zerop ret)(alert "\nFunction CANCELLED by user"))
   ( (eval (cadr (assoc ret
                        '( ( 1(_func1 "Hey Dude"))
                              ( 2(_func2 "What?"))
                  ( 3(_func3 "Seriously"))
                           )
                        )
                        )
                  )
   )
)
(princ)
)

(defun _func1 (m)
(alert (strcat m " The Earth is FLAT")))
(defun _func2 (m)
(alert (strcat m " No its NOT, The Earth is round")))
(defun _func3 (m)
(alert (strcat m " Its actually a bumpy spheroid")))

Alcapone001 发表于 2022-7-5 17:49:20

这太棒了，比格尔。
要么我不知道，要么我以前看过，完全忘记了。
我将尝试修改/分析它。

尝试更改：
(defun C:test ( / *error* fp fdcl dcl_id ret cmd )

(defun *error* (m)
(and dcl_id (unload_dialog dcl_id)) (and fp (vl-file-delete fp))
(and m (print m))
(princ)
); defun *error*

(setq fp (vl-filename-mktemp "tempfile.dcl"))
(setq fdcl (open fp "w"))
(write-line
"
dcl_test
: dialog
{
label = \"Test commands dialog\";
spacer;
: button
{
key = \"C1\";
label = \"Command1\";
}
spacer;
: button
{
key = \"C2\";
label = \"Command2\";
}
spacer;
: button
{
key = \"C3\";
label = \"Command3\";
}
spacer;
cancel_button;
}
"
fdcl
)
(close fdcl)
(setq dcl_id (load_dialog fp))
(if (new_dialog "dcl_test" dcl_id)
(progn
(action_tile "C1" "(setq cmd \"C1\") (done_dialog 1)")
(action_tile "C2" "(setq cmd \"C2\") (done_dialog 1)")
(action_tile "C3" "(setq cmd \"C3\") (done_dialog 1)")
(setq ret (start_dialog)) ; If Cancel is pressed ret will be 0.
(unload_dialog dcl_id) (and fp (vl-file-delete fp)) ; unload and delete the tempfile
)
(progn (alert "Can't load the dialog!") (and fp (vl-file-delete fp)))
)
(if (= 1 ret)
(cond
( (= "C1" cmd) (alert "ADDJ:") )
( (= "C2" cmd) (alert "CJ:") )
( (= "C3" cmd) (alert "Please enter your Command 3:") )
)
)
(princ)
)
(defun c:CJ (/ p x y z ptcoord textloc)
(while
(setq p (getpoint "
Pick Point: "))
(setq textloc (getpoint "
Pick Label Location: "))
(setq x (rtos (car p)))
(setq y (rtos (cadr p)))
(setq x (strcat "E " x))
(setq y (strcat "N " y))
(command "_LEADER" p textloc "" x y "") ;
)
)

******************************************************************************************************
; To add a given value to numbers and also to add decimal places

(defun c:ADDJ ( / ss)
(vl-load-com)
(if (and (setq ss (ssget (list (cons 0 "*text"))))
(setq amt (getreal "\nPlease type the amount you would like to add: ")))
(progn
(mapcar '(lambda (z) (vla-put-textstring z (rtos (+ (atof (vla-get-textstring z)) amt) 2 )))
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
)
)
(princ)
)

对此：

(if (= 1 ret)
(cond
( (= "C1" cmd) (alert "ADDJ:") )
( (= "C2" cmd) (alert "CJ:") )
( (= "C3" cmd) (alert "Please enter your Command 3:") )
)
)
如果您收到警报错误，则意味着您没有此类命令ADDJ/CJ/test。
在同一个文件中定义函数并不重要，它们可以单独加载。lsp文件与往常一样：

(if (= 1 ret)
(cond
( (= "C1" cmd)
(if C:ADDJ (C:ADDJ) (alert "\nFunction \"C:ADDJ\" not loaded, or not defined!"))
)
( (= "C2" cmd)
(if C:CJ (C:CJ) (alert "\nFunction \"C:CJ\" not loaded, or not defined!"))
)
( (= "C3" cmd)
(if C:test (C:test) (alert "\nFunction \"C:test\" not loaded, or not defined!"))
)
)
)

13

Grrr 发表于 2022-7-5 17:50:32

太棒了作品非常感谢大家。这个论坛真的很有用……：拇指支撑：

Alcapone001 发表于 2022-7-5 17:54:42

对于Grr，我很抱歉，但我很确定基本代码来自David Bethel。

14

15

BIGAL 发表于 2022-7-5 17:57:48

我对此并不怀疑，只是喜欢“list-prompt with dcl-maketemp dcl file”连接/组合的想法。

我甚至有“最喜欢的”子函数（LM:Listbox），这是相同的技术，尽管自从我开始使用LISP以来，我花了很长时间来找出如何正确使用它，甚至花了更多时间来“创建”类似的东西。

Grrr 发表于 2022-7-5 18:00:10

页: 1 [2]

乐筑天下's Archiver