[编程交流] 需要帮助吗

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

(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 [color="red"](= bb "0")[/color]
     (command "circle" (list x y) 2.0)
     (command "point" (list x y))
   )
 )

(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