XX工具箱

gaomingabc456

;;;;简单,容易,快速上手...........
(defun c:tt()
  (setq ml_ls (list
              ;;(list "命令名称" "命令")
                (list "快速加点" "POLYINS")
                (list "快速删点" "ERASEVERTEX")
                (list "封闭线" "PLBIHE")
                (list "复合线转权属" "PLTOJZLINE")
                (list "填充水田符号" "stfh")
                (list "填充旱地符号" "hdfh")
                (list "测试" "cs")
            )
     )
  (DCL_TOOL ml_ls)
)
(defun c:cs()
  (alert "测试")
  (prin1)
)
;;;后面的可根据需要进行修改
(defun DCL_TOOL (lst / lst1 n dclfilename)
  (setq dclfilename (vl-filename-mktemp nil nil ".dcl"))
  (setq fn (open dclfilename "w"))       
  (write-line "MB:dialog {" fn)
  (write-line "  label = \"XX工具箱\" ;" fn)
  (write-line "    :column {" fn)
  (setq n 0)
  (foreach lst1 lst
    (setq n (1+ n))
    (write-line "  :button {" fn)
    (write-line (strcat " key =   \"" (strcat "BU" (itoa n))"\";") fn)
    (write-line (strcat " label = \"" (car  lst1)"\";") fn)
    (write-line "  }" fn)
        )       
  (write-line "  }" fn)
  (write-line "  cancel_button;" fn)  
  (write-line "}" fn)
  (close fn)                
  (setq dcl_id (load_dialog dclfilename))
  (if (not (new_dialog "MB" dcl_id)) (exit))       
  (setq n 0)
  (foreach lst1 lst
        (setq n (1+ n))
        (action_tile (strcat "BU" (itoa n))(strcat "\(done_dialog " (itoa n) "\)"))
   )       
        (setq dd (start_dialog))
        (unload_dialog dcl_id)
        (vl-file-delete dclfilename)
        (if(> dd 0)
                (progn (setq tt (cadr (nth (1- dd) lst)))
                        (princ "\n")
                        (if (or (= (eval (read (strcat "(type c:" tt ")"))) 'USUBR)
                                (= (eval (read (strcat "(type c:" tt ")"))) 'SUBR)
                               )
                           (eval (read (strcat "(c:" tt ")")))
                           (vl-cmdf tt)
                        )
                )
        )
        (prin1)
)

sachindkini

dear sir,

thanks for sharing

AndyWang

k1nger 发表于 2021-8-20 08:44
下载测试了一下，DCL没问题，命令出错！

是打开工具箱命令出错？

傀儡koka

谢谢楼主源代码

w379106181

谢谢楼主源代码

zj20190405

老哥，为啥这个dcl和其他写法不一样

bonny

这个不是老麦那个么？？

k1nger

下载测试了一下，DCL没问题，命令出错！

xj6019

谢谢楼主源代码

ZMB7211

谢谢楼主源代码

utopio

谢谢分享，下载学习一下子。