DCL通用函数求解求优化

lea丶丶 · 发表于 2016-5-5 09:40:06

本帖最后由 lea丶丶于 2016-5-5 10:03 编辑

在前人基础上修改了DCL通用函数，但是为什么radio——button 获得属性值有问题。求优化

(vl-load-com)
;;;=================================================================*
(defun lea-dcl-init (STR_DIANAME LST /
LIST->DCL TEMPFILENAME F1
STR_JG I N DCLID
LST_RESULT
)
;;==================================================================*
;;功能：根据控件信息表，生成DCL语言的文本 *
;; 注意，调用参数均为字符串形式 *
;;返回：与控件对应的dcl文本
(defun LIST->DCL (LST / X)
(cond
;;写button
((wcmatch (car LST) "☆*")
(strcat
":button{"
(strcat "\nlabel=""
(nth 0 LST)
"";"
"\nis_enabled = false;"
)
"\n}\n"
)
)
;;写edit_box
((= (nth 2 LST) "int")
(strcat
":edit_box{"
"\nallow_accept = true ;"
(strcat "\nedit_width =20"
";"
)
"\nfixed_width = true ;"
(strcat "\nkey ="" (CAR N) "";")
(strcat "\nlabel=""
(nth 1 LST)
"";"
)
(strcat "\nvalue=""
(nth 3 LST)
"";"
)
"\n}\n"
)
)
;;写popup_list
((= (nth 2 LST) "poplist")
(strcat
":popup_list{"
(strcat "\nwidth =20"
";"
)
(strcat "\nlabel=""
(nth 1 LST)
"";"
)
(strcat "\nkey ="" (CAR N) "";")
(cond
((= (type (nth 3 LST)) 'STR)
(strcat "\nlist=""
(nth 3 LST)
"";"
)
)
((= (type (nth 3 LST)) 'list)
(strcat
"\nlist=""
(apply
'strcat
(mapcar
'(lambda (X)
(strcat "\\n"
(vl-princ-to-string X)
)
)
(nth 3 LST)
)
)
"";"
)
)
((= (type (nth 3 LST)) 'SYM)
(strcat
"\nlist=""
(apply
'strcat
(mapcar
'(lambda (X)
(strcat "\\n"
(vl-princ-to-string X)
)
)
(eval (nth 3 LST))
)
)
"";"
)
)
) ;_结束 cond
"\n}\n"
)
)
;;
((= (nth 2 LST) "list")
(strcat
":list_box{"
(strcat "\nwidth ="(nth 4 lst)
";"
)
(strcat "\nheight =" (nth 5 lst)
";"
)
(strcat "\nlabel=""
(nth 1 LST)
"";"
)
(strcat "\nkey ="" (CAR N) "";")
(cond
((= (type (nth 3 LST)) 'STR)
(strcat "\nlist=""
(nth 3 LST)
"";"
)
)
((= (type (nth 3 LST)) 'list)
(strcat
"\nlist=""
(apply
'strcat
(mapcar
'(lambda (X)
(strcat "\\n"
(vl-princ-to-string X)
)
)
(nth 3 LST)
)
)
"";"
)
)
((= (type (nth 3 LST)) 'SYM)
(strcat
"\nlist=""
(apply
'strcat
(mapcar
'(lambda (X)
(strcat "\\n"
(vl-princ-to-string X)
)
)
(eval (nth 3 LST))
)
)
"";"
)
)
) ;_结束 cond
"\n}\n"
)
)
;;
((= (car LST) "text")
(strcat
":text{"
(strcat "\nlabel=""
(nth 1 LST)
"";"
)
"\n}\n"
)
)
;;
((= (nth 1 LST) "radio_button")
(strcat "\nkey ="" (CAR N) "";")
(strcat
":radio_button{"
(strcat "\nlabel=""
(nth 2 LST)
"";"
)
"\n}\n"
)
)
;;
((= (car LST) "spacer_1")
(strcat "\n"
(nth 0 LST)
";\n"
)
)
;;
((= (car LST) "boxed_column")
(strcat
":boxed_column{"
(strcat "\nlabel=""
(nth 1 LST)
"";"
)
"\n"
)
)
;;
((= (car LST) "boxed_radio_row")
(strcat
":boxed_radio_row{"
(strcat "\nlabel=""
(nth 1 LST)
"";"
)
"\n"
)
)
((= (car LST) "}")
(strcat
"\n}\n"
)
)
;;; ((/= (LIST->DCL (cons "editbox" LST) KEY_I) "")
;;; (LIST->DCL (cons "editbox" LST) KEY_I)
;;; )
(t "")
) ;_结束 cond
) ;_结束defun
;;==================================================================*
;;功能：定义按下确定按钮后的操作
(defun getinput (lst / i n tmp)
(setq i 0)
(repeat (length lst)
(setq n (nth i lst)
i (1+ i)
)
(cond
((= (nth 2 n) "int")
(set (read (car n)) (atof (get_tile (car n))))
)
;;
((= (nth 1 n) "radio_button")
(set (read (car n)) (get_attr (car n) "label"));此处获得属性值哪里出问题了
)
;;
((= (nth 2 n) "poplist")
(setq tmp (nth 3 n))
(cond ((= (type (nth 3 n)) 'str)
(setq tmp "*inputbox函数有待完善*")
)
((= (type (nth 3 n)) 'list)
(set (read (car n))
(nth (atoi (get_tile (car n))) tmp)
)
)
((= (type (nth 3 n)) 'sym)
(set (read (car n))
(nth (atoi (get_tile (car n))) (eval tmp))
)
)
)
)
;;
((= (nth 2 n) "list")
(setq tmp (nth 3 n))
(cond ((= (type (nth 3 n)) 'str)
(setq tmp "*inputbox函数有待完善*")
)
((= (type (nth 3 n)) 'list)
(set (read (car n))
(atof (nth (atoi (get_tile (car n))) tmp))
)
)
((= (type (nth 3 n)) 'sym)
(set (read (car n))
(nth (atoi (get_tile (car n))) (eval tmp))
)
)
)
)
;
)
)
)
;_结束defun
;;==================================================================*
(setq TEMPFILENAME (vl-filename-mktemp "dcltmp.dcl"))
(setq F1 (open TEMPFILENAME "w"))
;;组织头部
(setq STR_JG (strcat
"InputBox:dialog {"
(strcat "\nlabel ="" STR_DIANAME "";")
)
)
;;组织正文
(setq I 0)
(repeat (length LST)
(setq N (nth I LST))
(setq STR_JG (strcat STR_JG
(LIST->DCL N )
)
)
(setq I (1+ I))
)
;;组织按钮
(setq STR_JG
(strcat STR_JG
"\nspacer_0;"
"\nok_cancel;\n}\n"
)
)
;;写入文件
(princ STR_JG F1)
;;关闭文件
(close F1)
(setq DCLID (load_dialog TEMPFILENAME))
(if (not (new_dialog "InputBox" DCLID ""))
(progn (alert "对话框加载失败!") (exit))
)
(action_tile
"accept"
"(GetInput Lst ) (done_dialog 1)"
)
(start_dialog)
(unload_dialog DCLID)
(vl-file-delete TEMPFILENAME)
;;返回
)
;(lea-dcl-init "图库"
; '( ("boxed_column" "文件")
; ("blockname" "名称" "list" allfile1 "40" "40");40宽度 40高度
; ("}")
; ("boxed_radio_row" "分类")
; ("txt" "radio_button" "电气")
; ("txt" "radio_button" "土建")
; ("}") )
; )

(vl-load-com) 
;;;=================================================================* 
(defun lea-dcl-init (STR_DIANAME      LST       / 
                          LIST->DCL  TEMPFILENAME       F1 
                          STR_JG     I    N       DCLID 
                          LST_RESULT 
                        ) 
  ;;==================================================================* 
  ;;功能：根据控件信息表，生成DCL语言的文本                           * 
  ;;      注意，调用参数均为字符串形式                                * 
  ;;返回：与控件对应的dcl文本 
  (defun LIST->DCL (LST  / X) 
    (cond 
      ;;写button 
      ((wcmatch (car LST) "☆*") 
        (strcat 
          ":button{" 
          (strcat "\nlabel="" 
            (nth 0 LST) 
            "";" 
            "\nis_enabled = false;" 
          ) 
          "\n}\n" 
        ) 
      ) 
   
      ;;写edit_box 
      ((= (nth 2 LST) "int") 
        (strcat 
          ":edit_box{" 
          "\nallow_accept = true ;" 
          (strcat "\nedit_width =20" 
            ";" 
          ) 
          "\nfixed_width = true ;" 
          (strcat "\nkey ="" (CAR N) "";") 
          (strcat "\nlabel="" 
            (nth 1 LST) 
            "";" 
          ) 
          (strcat "\nvalue="" 
            (nth 3 LST) 
            "";" 
          ) 
          "\n}\n" 
        ) 
      ) 
      ;;写popup_list 
      ((= (nth 2 LST) "poplist") 
        (strcat 
          ":popup_list{" 
          (strcat "\nwidth =20" 
            ";" 
          ) 
          (strcat "\nlabel="" 
            (nth 1 LST) 
            "";" 
          ) 
          (strcat "\nkey ="" (CAR N) "";") 
          (cond 
            ((= (type (nth 3 LST)) 'STR) 
              (strcat "\nlist="" 
                (nth 3 LST) 
                "";" 
              ) 
            ) 
            ((= (type (nth 3 LST)) 'list) 
              (strcat 
                "\nlist="" 
                (apply 
                  'strcat 
                  (mapcar 
                    '(lambda (X) 
                       (strcat "\\n" 
                         (vl-princ-to-string X) 
                       ) 
                     ) 
                    (nth 3 LST) 
                  ) 
                ) 
                "";" 
              ) 
            ) 
            ((= (type (nth 3 LST)) 'SYM) 
              (strcat 
                "\nlist="" 
                (apply 
                  'strcat 
                  (mapcar 
                    '(lambda (X) 
                       (strcat "\\n" 
                         (vl-princ-to-string X) 
                       ) 
                     ) 
                    (eval (nth 3 LST)) 
                  ) 
                ) 
                "";" 
              ) 
            ) 
          ) ;_结束 cond 
          "\n}\n" 
        ) 
      ) 
      ;; 
      ((= (nth 2 LST) "list") 
        (strcat 
          ":list_box{" 
          (strcat "\nwidth ="(nth 4 lst) 
            ";" 
          ) 
          (strcat "\nheight =" (nth 5 lst) 
            ";" 
          ) 
          (strcat "\nlabel="" 
            (nth 1 LST) 
            "";" 
          ) 
          (strcat "\nkey ="" (CAR N) "";") 
          (cond 
            ((= (type (nth 3 LST)) 'STR) 
              (strcat "\nlist="" 
                (nth 3 LST) 
                "";" 
              ) 
            ) 
            ((= (type (nth 3 LST)) 'list) 
              (strcat 
                "\nlist="" 
                (apply 
                  'strcat 
                  (mapcar 
                    '(lambda (X) 
                       (strcat "\\n" 
                         (vl-princ-to-string X) 
                       ) 
                     ) 
                    (nth 3 LST) 
                  ) 
                ) 
                "";" 
              ) 
            ) 
            ((= (type (nth 3 LST)) 'SYM) 
              (strcat 
                "\nlist="" 
                (apply 
                  'strcat 
                  (mapcar 
                    '(lambda (X) 
                       (strcat "\\n" 
                         (vl-princ-to-string X) 
                       ) 
                     ) 
                    (eval (nth 3 LST)) 
                  ) 
                ) 
                "";" 
              ) 
            ) 
          ) ;_结束 cond 
          "\n}\n" 
        ) 
      ) 
      ;; 
      ((= (car LST) "text") 
        (strcat 
          ":text{" 
          (strcat "\nlabel="" 
            (nth 1 LST) 
            "";" 
          ) 
          "\n}\n" 
        ) 
      ) 
       ;; 
      ((= (nth 1 LST) "radio_button") 
      (strcat "\nkey ="" (CAR N) "";") 
        (strcat 
          ":radio_button{" 
          (strcat "\nlabel="" 
            (nth 2 LST) 
            "";" 
          ) 
          "\n}\n" 
        ) 
      ) 
      ;; 
      ((= (car LST) "spacer_1") 
        (strcat "\n" 
          (nth 0 LST) 
          ";\n" 
        ) 
      ) 
      ;; 
      ((= (car LST) "boxed_column") 
        (strcat 
          ":boxed_column{" 
          (strcat "\nlabel="" 
            (nth 1 LST) 
            "";" 
          ) 
          "\n" 
        ) 
      ) 
      ;; 
      ((= (car LST) "boxed_radio_row") 
        (strcat 
          ":boxed_radio_row{" 
          (strcat "\nlabel="" 
            (nth 1 LST) 
            "";" 
          ) 
          "\n" 
        ) 
      ) 
      ((= (car LST) "}") 
        (strcat 
          "\n}\n" 
        ) 
      ) 
      ;;;      ((/= (LIST->DCL (cons "editbox" LST) KEY_I) "") 
      ;;;       (LIST->DCL (cons "editbox" LST) KEY_I) 
      ;;;      ) 
      (t "") 
    ) ;_结束 cond 
  ) ;_结束defun 
  ;;==================================================================* 
  ;;功能：定义按下确定按钮后的操作 
   
(defun getinput  (lst / i n tmp) 
  (setq i 0) 
  (repeat (length lst) 
    (setq n (nth i lst) 
    i (1+ i) 
    ) 
    (cond 
      ((= (nth 2 n) "int") 
     (set (read (car n)) (atof (get_tile (car n)))) 
    ) 
      ;; 
     ((= (nth 1 n) "radio_button") 
     (set (read (car n)) (get_attr (car n) "label"));此处获得属性值哪里出问题了 
    ) 
      ;; 
    ((= (nth 2 n) "poplist") 
     (setq tmp (nth 3 n)) 
     (cond ((= (type (nth 3 n)) 'str) 
      (setq tmp "*inputbox函数有待完善*") 
     ) 
     ((= (type (nth 3 n)) 'list) 
      (set (read (car n)) 
            (nth (atoi (get_tile (car n))) tmp) 
      ) 
     ) 
        ((= (type (nth 3 n)) 'sym) 
      (set (read (car n)) 
            (nth (atoi (get_tile (car n))) (eval tmp)) 
      ) 
     ) 
       
     ) 
    ) 
  ;; 
      ((= (nth 2 n) "list") 
     (setq tmp (nth 3 n)) 
     (cond ((= (type (nth 3 n)) 'str) 
      (setq tmp "*inputbox函数有待完善*") 
     ) 
     ((= (type (nth 3 n)) 'list) 
      (set (read (car n)) 
           (atof (nth (atoi (get_tile (car n))) tmp)) 
      ) 
     ) 
        ((= (type (nth 3 n)) 'sym) 
      (set (read (car n)) 
            (nth (atoi (get_tile (car n))) (eval tmp)) 
      ) 
     ) 
       
     ) 
    ) 
      ; 
    ) 
  ) 
) 
  ;_结束defun 
  ;;==================================================================* 
  (setq TEMPFILENAME (vl-filename-mktemp "dcltmp.dcl")) 
  (setq F1 (open TEMPFILENAME "w")) 
   
  ;;组织头部 
  (setq  STR_JG (strcat 
                 "InputBox:dialog {" 
                 (strcat "\nlabel ="" STR_DIANAME "";") 
               ) 
  ) 
  ;;组织正文 
  (setq I 0) 
  (repeat (length LST) 
    (setq N (nth I LST)) 
    (setq STR_JG (strcat STR_JG 
                   (LIST->DCL N ) 
                 ) 
    ) 
    (setq I (1+ I)) 
  ) 
   
  ;;组织按钮 
  (setq  STR_JG 
    (strcat STR_JG 
      "\nspacer_0;" 
      "\nok_cancel;\n}\n" 
    ) 
  ) 
  ;;写入文件 
  (princ STR_JG F1) 
  ;;关闭文件 
  (close F1) 
  (setq DCLID (load_dialog TEMPFILENAME)) 
  (if (not (new_dialog "InputBox" DCLID "")) 
    (progn (alert "对话框加载失败!") (exit)) 
  ) 
  (action_tile 
    "accept" 
    "(GetInput  Lst ) (done_dialog 1)" 
  ) 
 (start_dialog) 
  (unload_dialog DCLID) 
  (vl-file-delete TEMPFILENAME) 
  ;;返回 
 
) 
;(lea-dcl-init  "图库" 
;                '(  ("boxed_column" "文件") 
;                    ("blockname"  "名称" "list" allfile1 "40" "40");40宽度  40高度   
;                    ("}") 
;                     ("boxed_radio_row" "分类") 
;                    ("txt" "radio_button" "电气") 
;                    ("txt" "radio_button" "土建")   
;                     ("}")  ) 
;  )

lea丶丶 · 发表于 2016-5-5 11:34:43

竟然没人呢

xiaolong1487 · 发表于 2016-5-6 00:39:10

1. (strcat "\nkey =\"" (CAR N) "\";") 这里有几处有问题，应该是  (strcat "\nkey =\"" (CAR LST) "\";")

2. ((= (nth 1 LST) "radio_button")
   (strcat "\nkey =\"" (CAR N) "\";")
      (strcat
      ":radio_button{"
      (strcat "\nlabel=\""
......
key 同1点问题，位置也放错了，应该是
((= (nth 1 LST) "radio_button")
      (strcat
      ":radio_button{"
      (strcat "\nkey =\"" (CAR N) "\";")
      (strcat "\nlabel=\""

3. (set (read (car n)) (get_attr (car n) "label"));此处获得属性值哪里出问题了
改为 (set (read (car n)) (atof (get_tile (car n))))

4.(setq tmp "*inputbox函数有待完善*")
改为 (set (read (car n)) tmp)

lea丶丶 · 发表于 2016-5-6 15:21:42

xiaolong1487 发表于 2016-5-6 00:39
1. (strcat "\nkey =\"" (CAR N) "\";") 这里有几处有问题，应该是 (strcat "\nkey =\"" (CAR LST) "\";") ...

谢谢，这错误真是不该犯的

账号		自动登录	找回密码
密码			注册

DCL通用函数求解求优化

相关帖子

评分

DCL通用函数 求解 求优化

相关帖子

评分

DCL通用函数求解求优化