zhongys 发表于 2014-11-26 17:35:27

求DCL合并

因用UG转出的DWG图档较多。经常要删除，不胜其烦，想在CAD中用指令操作。已写好LSP及DCL（DCL用LSP写的)，我对于DCL的处理也是一知半解，求将两个整合在一起。

ZZXXQQ 发表于 2014-11-27 09:13:43

本帖最后由 ZZXXQQ 于 2014-11-27 19:59 编辑

tianyi1230 发表于 2014-11-27 08:20 http://bbs.mjtd.com/static/image/common/back.gif
楼主意思是打包为vlx后缀的插件？(defun c:ddwg(/ AcadObject AcadDocument mSpace folder filelst kt)
(vl-load-com)
(defun *error* (msg)(princ))
(setq AcadObject (vlax-get-acad-object)
          AcadDocument (vla-get-ActiveDocument Acadobject)
          mSpace      (vla-get-ModelSpace Acaddocument)
)
(am1)
(setq folder (acet-ui-pickdir (strcat "选择要删除" ar_num "文件的文件夹: ")))
    ;(princ folder)
(if (/= folder nil) (progn
   (setq filelst (vl-directory-files Folder ar_num 1))
   (setq filelst (GetAllFiles folder ar_num))
   (alert
   (strcat "\n\t警告\n此操作会删除当前文件夹下的所有" ar_num "文件\n文件不可恢复,请慎重操作!")
   )
   (initget "Y N ")
   (setq kt (getkword(strcat "\n [确认删除当前文件夹下的所有" ar_num "文件,文件不可恢复(Yes)/不删除<No>]: ")))
   (if (= kt "Y")
    (foreach v filelst (vl-file-delete v))
   )
)
   (princ (strcat "\n 该文件夹下没有"ar_num "文件"))
)
(princ)
)
(defun GetAllFiles (dir typ);;;by明经
(append
    (mapcar '(lambda (x) (strcat dir "\\" x))
      (vl-directory-files dir typ 1)
    )
    (apply 'append
      (mapcar '(lambda (x) (GetAllFiles (strcat dir "\\" x) typ))
      (vl-remove-if
          '(lambda (x) (wcmatch x "`.,`.`."))
          (vl-directory-files dir "*" -1)
      )
      )
    )
)
)
(defun am1()
(setq dcl_name "am1");;;定义对话框名称
(setq dcl_nx3 ":dialog{label=\"文件删除\";");;;统一对话框表头,可以外部引用
(setq dcl_nx2 (strcat dcl_name dcl_nx3))
(setq dcl_name (strcat (getenv "temp") "\\" dcl_name ".dcl"))
(setqf (open dcl_name "w"))
(write-line dcl_nx2 f)
(foreach x '(
    "spacer_1 ;"
    ":row{"
    ":edit_box{label=\"文件路径\";key=\"edit_path\";edit_width=40;}"
    ":button{label=\"<\";key=\"path_ok\";width=5;}"
   "}"
    "spacer_1 ;"
   ":row{"
   ":boxed_radio_column{"
      "label=\"文件格式\";"
      "key=\"ext\";"
      ":radio_button{label=\"dwg\";key=\"d1\";value=\"1\";}"
      ":radio_button{label=\"dxf\";key=\"d2\";}"
      ":radio_button{label=\"bak\";key=\"d3\";}"
      ":radio_button{label=\"dat\";key=\"d4\";}"
      ":radio_button{label=\"txt\";key=\"d5\";}"
      ":radio_button{label=\"log.*\";key=\"d6\";}"
      ":radio_button{label=\"xml\";key=\"d7\";}"
   "}"
    ":boxed_radio_column{label=\"警告\";"
    "spacer_1;"
    ":text{label=\"警告\";alignment=centered;}"
    "spacer_1;"
    ":text{label=\"此操作会删除当前文件夹下的所有批定格式文件\";alignment=centered;}"
    "spacer_1;"
    ":text{label=\"文件不可恢复,请慎重操作!\";alignment=centered;}"
    "spacer_1;"
    "spacer_1;"
    "spacer_1;"
   "}"
   "}//关闭橫列元件"
    "spacer_1 ;"
    "ok_cancel;"
    "}")
(princ x f)
(write-line "" f)
)
(close f)
(if (> (setq dcl_id (load_dialog dcl_name)) 0) (progn
(if (new_dialog "am1" dcl_id) (progn
(action_tile "accept" "(readata) (done_dialog 1")
(action_tile "cancel"   "(done_dialog 0)")
(setq kt (start_dialog))
) (princ "\n无法显示对话框！"))
(unload_dialog dcl_id)
) (princ "\n无法加载对话框！"))
(if (= kt 1)
(setq ar_num (strcat "*." ar_num))
)
(princ)
)
(defun readata ()
(setq ar_num
   (nth(atoi(substr(get_tile "ext") 2 1)) '("dwg" "dxf" "bak" "dat" "txt" "log.*" "xml"))
)
)

tianyi1230 发表于 2014-11-27 08:20:43

楼主意思是打包为vlx后缀的插件？

lucas_3333 发表于 2014-11-27 08:26:18

tianyi1230 发表于 2014-11-27 08:20 static/image/common/back.gif
楼主意思是打包为vlx后缀的插件？

理解有问题！

楼主的意思是 两个合成一个lisp

楼主，貌似你的主程序还有问题吧，你这不仅仅要合并啊

zhongys 发表于 2014-11-27 08:31:17

意思是给LSP加个DCL

ymcui 发表于 2014-11-27 14:16:57

ZZXXQQ 发表于 2014-11-27 09:13 static/image/common/back.gif


无法加载对话框！




zhongys 发表于 2014-11-27 14:25:56

ymcui 发表于 2014-11-27 14:16 static/image/common/back.gif
无法加载对话框！

":key=\"ext\";"====>>>"key=\"ext\";"

lucas_3333 发表于 2014-11-27 22:24:23

ZZXXQQ 发表于 2014-11-27 09:13 static/image/common/back.gif


Z版还真是不一般的热心啊，楼主的程序都不完整， path_okkey 都没用上，不能指定路径， 请问楼主你怎么用？

zhongys 发表于 2014-11-28 10:15:15

要是不用对话框，使用DDWG这个程式也可以用的。
页: [1]
查看完整版本: 求DCL合并