需要帮助吗
大家好,我需要帮助再次在DCL时,我点击创建按钮,它不工作,需要很长时间
请帮忙
DCL
pickpoint:dialog
{
label="Pickpoint";
:row
{
:popup_list
{
label="Create :";
key="crt";
edit_width=15;
}
:button
{
label="Pick Point";
key="pick";
width=5;
height=1.5;
}
}
:column
{
:edit_box
{
label="Easting";
key="e";
edit_width=15;
}
:edit_box
{
label="Northing";
key="n";
edit_width=15;
}
}
:button
{
label="Create";
key="ok";
is_default=true;
is_cancel=false;
}
}
Autolisp
(defun c:test()
(setq e "")
(setq n "")
(setq crt "0")
(setq flag 4)
(setq lst (list "Circle" "Point"))
(setq dcl (load_dialog "pickpoint.dcl"))
(defun check(bb x y)
(if (= bb "Circle")
(command "circle" (list x y) 2.0)
(command "point" (list x y))
)
)
(while (> flag 2)
(if (not (new_dialog "pickpoint" dcl))
(exit)
)
(set_tile "e" e)
(set_tile "n" n)
(set_tile "crt" crt)
(start_list "crt")
(mapcar 'add_list lst)
(end_list)
(action_tile "crt" "(setq ob $value)(setq crt (get_tile \"crt\"))")
(action_tile "pick" "(done_dialog 4)")
(action_tile "ok" "(check ob (atof e) (atof n)) (done_dialog 1)")
(setq flag (start_dialog))
(if (= flag 4)
(progn
(setq pos (getpoint))
(setq e (rtos (car pos))
n (rtos (cadr pos))
)
)
)
)
(done_dialog dcl)
(princ)) 检查一次:
(defun check(bb x y)
(if (= bb "0")
(command "circle" (list x y) 2.0)
(command "point" (list x y))
)
)
命令调用在action\u tile中不起作用,因此您必须在卸载对话框后调用该子函数。 谢谢Tharwat,我从未在那里使用过任何命令功能,所以我没有这个想法 以下是我的练习代码,在向Lee Mac学习后,关于编写这样的DCL:
(defun C:test ( / *error* dcl des dch dcf e n ob p )
(defun *error* ( msg )
(and (< 0 dch) (unload_dialog dch))
(and (eq 'FILE (type des)) (close des))
(and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
(and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\nError: " msg)) )
(princ)
); defun *error*
(cond
(
(not
(and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
(princ
(strcat
"pickpoint : dialog"
"{ label = \"Pickpoint\";"
": row"
"{ : popup_list { label = \"Create :\"; key = \"crt\"; edit_width = 15; }"
" : button { label = \"Pick Point\"; key = \"pick\"; width = 5; height = 1.5; }"
"}"
": column"
"{ : edit_box { label = \"Easting\"; key = \"e\"; edit_width = 15; }"
" : edit_box { label = \"Northing\"; key = \"n\"; edit_width = 15; }"
"}"
": button { label = \"Create\"; key = \"ok\"; is_default = true; is_cancel = false; }"
"}"
); strcat
des
); princ / write-line
(not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
); and
); not
(princ "\nUnable to write or load the DCL file.")
)
(
(progn
(mapcar 'set '(e n ob) '("" "" "0"))
(while (/= 1 dcf)
(cond
( (not (new_dialog "pickpoint" dch)) (princ "\nUnable to display the dialog") (setq dcf 1) )
(T
(set_tile "crt" ob)
(mapcar 'set_tile '("e" "n") (list e n))
(start_list "crt") (mapcar 'add_list '("Circle" "Point")) (end_list)
(mapcar
'(lambda (x) (apply 'action_tile x))
'(("e" "(setq e $value)") ("n" "(setq n $value)") ("crt" "(setq ob $value)") ("pick" "(done_dialog 2)"))
)
(action_tile "ok"
(vl-prin1-to-string
'(cond
( (= "" e) (alert "\nSpecify Easting value!") )
( (= "" n) (alert "\nSpecify Northing value!") )
( (not (numberp (read e))) (alert "\nInvalid Easting value!") )
( (not (numberp (read n))) (alert "\nInvalid Northing value!") )
( (done_dialog 1) )
)
)
)
(setq dcf (start_dialog))
)
); cond
(if (and (= 2 dcf) (setq p (getpoint "\nSpecify point: ")))
(mapcar 'set '(e n) (mapcar 'rtos (list (car p) (cadr p))))
); if
); while
(if (setq p (list (read e) (read n) 0.))
(entmakex
(cadr
(assoc ob
(list
(list "0" (list (cons 0 "CIRCLE") (cons 10 p) (cons 40 2.0)))
(list "1" (list (cons 0 "POINT") (cons 10 p)))
)
)
)
)
)
(*error* nil)
); progn
)
); cond
(princ)
); defun
哇!Grrr可能需要很多天才能为我学习。。但是请指导我如何使用tharwat所说的这些子函数
使用Tapatalk从我的SM-E700H发送 我想从下层社会学习
使用Tapatalk从我的SM-E700H发送
为了避免命令调用,您必须使用entmake/x(检查此线程)或调用vla add方法(需要activex)。 与Tharwat一样,dcl内的“拾取点”选项在此处已多次提出,您确实需要关闭dcl拾取点并再次弹出dcl。您可以在dcl内执行“Pick”操作,或在“Pick”选项旁边的框中输入X和Y,如果执行“Pick”,则可以在返回dcl并继续时显示点xy值。 @bigal哦!这就是为什么autocad需要这么长时间才能自动关闭的原因
我想按照你的指示修改我的代码
谢谢你,比格尔
使用Tapatalk从我的SM-E700H发送
页:
[1]
2