求DCL合并

zhongys

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

ZZXXQQ

tianyi1230 发表于 2014-11-27 08:20
楼主意思是打包为vlx后缀的插件？

2. (defun c:ddwg  (/ AcadObject AcadDocument mSpace folder filelst kt)
   
3.   (vl-load-com)
   
4.   (defun *error* (msg)(princ))
   
5.   (setq AcadObject (vlax-get-acad-object)
   
6.           AcadDocument (vla-get-ActiveDocument Acadobject)
   
7.           mSpace        (vla-get-ModelSpace Acaddocument)
   
8.   )
   
9.   (am1)
   
10.   (setq folder (acet-ui-pickdir (strcat "选择要删除" ar_num "文件的文件夹: ")))
    
11.     ;(princ folder)
    
12.   (if (/= folder nil) (progn
    
13.    (setq filelst (vl-directory-files Folder ar_num 1))
    
14.    (setq filelst (GetAllFiles folder ar_num))
    
15.    (alert
    
16.      (strcat "\n\t警告\n此操作会删除当前文件夹下的所有" ar_num "文件\n文件不可恢复,请慎重操作!")
    
17.    )
    
18.    (initget "Y N ")
    
19.    (setq kt (getkword(strcat "\n [确认删除当前文件夹下的所有" ar_num "文件,文件不可恢复(Yes)/不删除<No>]: ")))
    
20.    (if (= kt "Y")
    
21.     (foreach v filelst (vl-file-delete v))
    
22.    )
    
23.   )
    
24.    (princ (strcat "\n 该文件夹下没有"ar_num "文件"))
    
25.   )
    
26.   (princ)
    
27. )
    
28. (defun GetAllFiles (dir typ);;;by明经
    
29.   (append
    
30.     (mapcar '(lambda (x) (strcat dir "\" x))
    
31.       (vl-directory-files dir typ 1)
    
32.     )
    
33.     (apply 'append
    
34.       (mapcar '(lambda (x) (GetAllFiles (strcat dir "\" x) typ))
    
35.         (vl-remove-if
    
36.           '(lambda (x) (wcmatch x "`.,`.`."))
    
37.           (vl-directory-files dir "*" -1)
    
38.         )
    
39.       )
    
40.     )
    
41.   )
    
42. )
    
43. (defun am1()
    
44.   (setq dcl_name "am1");;;定义对话框名称
    
45.   (setq dcl_nx3 ":dialog{label="文件删除";");;;统一对话框表头,可以外部引用
    
46.   (setq dcl_nx2 (strcat dcl_name dcl_nx3))
    
47.   (setq dcl_name (strcat (getenv "temp") "\" dcl_name ".dcl"))
    
48.   (setq  f (open dcl_name "w"))
    
49.   (write-line dcl_nx2 f)
    
50.   (foreach x '(
    
51.     "spacer_1 ;"
    
52.     ":row{"
    
53.     ":edit_box{label="文件路径";key="edit_path";edit_width=40;}"
    
54.     ":button{label="<";key="path_ok";width=5;}"
    
55.      "}"
    
56.     "spacer_1 ;"
    
57.      ":row{"
    
58.      ":boxed_radio_column{"
    
59.         "label="文件格式";"
    
60.         "key="ext";"
    
61.         ":radio_button{label="dwg";key="d1";value="1";}"
    
62.         ":radio_button{label="dxf";key="d2";}"
    
63.         ":radio_button{label="bak";key="d3";}"
    
64.         ":radio_button{label="dat";key="d4";}"
    
65.         ":radio_button{label="txt";key="d5";}"
    
66.         ":radio_button{label="log.*";key="d6";}"
    
67.         ":radio_button{label="xml";key="d7";}"
    
68.      "}"
    
69.     ":boxed_radio_column{label="警告";"
    
70.     "spacer_1;"
    
71.     ":text{label="警告";alignment=centered;}"
    
72.     "spacer_1;"
    
73.     ":text{label="此操作会删除当前文件夹下的所有批定格式文件";alignment=centered;}"
    
74.     "spacer_1;"
    
75.     ":text{label="文件不可恢复,请慎重操作!";alignment=centered;}"
    
76.     "spacer_1;"
    
77.     "spacer_1;"
    
78.     "spacer_1;"
    
79.      "}"
    
80.      "}  //关闭橫列元件"
    
81.     "spacer_1 ;"
    
82.     "ok_cancel;"
    
83.     "}")
    
84. (princ x f)
    
85. (write-line "" f)
    
86. )
    
87. (close f)
    
88. (if (> (setq dcl_id (load_dialog dcl_name)) 0) (progn
    
89. (if (new_dialog "am1" dcl_id) (progn
    
90.   (action_tile "accept" "(readata) (done_dialog 1")
    
91.   (action_tile "cancel"   "(done_dialog 0)")
    
92.   (setq kt (start_dialog))
    
93. ) (princ "\n无法显示对话框！"))
    
94. (unload_dialog dcl_id)
    
95. ) (princ "\n无法加载对话框！"))
    
96. (if (= kt 1)
    
97. (setq ar_num (strcat "*." ar_num))
    
98. )
    
99. (princ)
    
100. )
     
101. (defun readata ()
     
102. (setq ar_num
     
103.    (nth(atoi(substr(get_tile "ext") 2 1)) '("dwg" "dxf" "bak" "dat" "txt" "log.*" "xml"))
     
104. )
     
105. )
     

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

tianyi1230

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

lucas_3333

tianyi1230 发表于 2014-11-27 08:20
楼主意思是打包为vlx后缀的插件？

理解有问题！

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

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

zhongys

意思是给LSP加个DCL

ymcui

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

无法加载对话框！

zhongys

ymcui 发表于 2014-11-27 14:16
无法加载对话框！

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

lucas_3333

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

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

zhongys

要是不用对话框，使用DDWG这个程式也可以用的。