关于LISP批量处理查找文件的问题

rc21

下面是在网上找的一段图纸批量处理程序，经使用发现只能在所选择的根目录查找dwg文件，对于子目录的dwg文件却不能查找到，因本人不懂LISP也就无法修改，请大师们帮帮忙，给改改这个段程序，使之不论是选择的根目录还是此根目录下的子目录也能查找到所有dwg文件，在此先谢过！！

9 ]  {3 _) Z. b" ~
1 J" t6 n- T" ?  H" Z: H! L& U$ e! b(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
) t* P9 m7 C! e5 q. V) b( |+ d(vl-load-com)
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
(setvar "cmdecho" 0)
' V) N9 ?; O2 h+ @% A3 W# D+ H! W (setq path
(strcat
$ L# q' {9 H3 P5 ~5 d (vl-string-right-trim
% f; E6 d- G7 f+ ~( }/ h/ p) h  Q "\\"
: q9 k3 ?* y# f- T, q% v# |+ _ (strcase (acet-ui-pickdir
0 @: [2 s* _, K5 ` "选择目录"
3 ]1 F3 u6 O7 Y  Q$ W3 U. o (vl-string-right-trim "\\" (getvar "dwgprefix"))
" r6 f3 Z( d7 Z  }2 T4 u& _% L1 w/ W "批量修改"
4 P& ^8 V/ A6 ]6 X )
( b# ?: D6 `2 G7 Z' t )
)
"\\"
$ V4 u! y5 V3 S' b )
)
7 U: m2 c5 H% _4 j( f3 E (setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
(setvar "acadlspasdoc" 0)
(setq dwgname (vl-directory-files path "*.DWG"))
(setq num 0)
- {/ D1 u2 w/ ~ (if (/= dwgname NIL)
(progn
9 U& ?: G3 M) G7 D4 Z% l0 W (setq APP (vlax-get-acad-object));获得Acad 对象
9 b) @" D+ }4 {0 s( ~(repeat (length dwgname)
(setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
& l! J4 _* N) Z: O1 q& O (setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
- D4 X( |' }: P6 C 得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
& G! B8 f9 C; h$ t;; …
;; …
/ P9 x$ K; g# Z, U  ?7 t(vla-close doc :vlax-false);关闭图形(不检查是否保存)
(setq num (1+ num))
)
(vlax-release-object doc)
(vlax-release-object APP)
# g- r2 i+ \8 ? )
% J$ \4 F# N; k8 U. }: J: N. w (prompt "\n所选目录中未有任何图形!!")
  R; [4 G" R- ? )
(setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
$ ^- u) n7 P# ~5 A* N6 t' _(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
(princ)
) E! l2 Z  [& I3 y8 K8 Y/ Y )

woaishuijia

代码本身只有一点小问题,应该是你上传时操作错误造成的,应与代码无关.重新帖一次,对照一下

1. (arxload "acetutil.arx" NIL)
   - J! s/ |* v% s2 |3 N" @) h
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   
5. ;;主程序定义
   
6. (setq OLDECHO (getvar "cmdecho"))
   1 @* Q2 G$ E" Q/ W7 F
7. ;;保存系统变量值
   1 v2 x, Z! p" U+ X3 V
8. (setvar "cmdecho" 0)
   + o4 Y+ Z" ~* k* K+ i" X
9. (setq path
   , B7 e/ d8 v8 ^  j! m% D* Z& W7 R
10. (strcat
    3 z* E3 l$ O1 z0 H( v
11. (vl-string-right-trim
    
12. "\"
    3 h/ N8 [6 P2 m2 Q9 w9 c. l
13. (strcase (acet-ui-pickdir
    : i9 m" L1 i! M) j
14. "选择目录"
    ' o' X: P3 K+ h& K4 O3 P* T
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16. "批量修改"
    
17. )
    % [+ G  p4 Q. }+ k) U
18. )
    
19. )
    . _# ^* }- a) {) p* U8 p
20. "\"
    ! G5 u$ n, G1 n6 r; g, l
21. )
    # K1 c) e2 Z6 S7 ^) r
22. )
    
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24. ;;保存系统变量值
    
25. (setvar "acadlspasdoc" 0)
    % V" y# Q$ y5 ?4 z  }2 F
26. (setq dwgname (vl-directory-files path "*.DWG"))
    
27. (setq num 0)
    
28. (if (/= dwgname NIL)
    
29. (progn
    % \% m$ d9 a2 ]$ X7 y
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    " z+ h; |& T- y
31. (repeat (length dwgname)
    
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34. ;打开图形并获得其对象
    : D$ L) o0 l, _" n' W* l  q$ x
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    ( G- z( ^3 N) ]
36. ;; …
    
37. ;; …
    2 U' I) z- z+ ]* g' W, r3 g2 S/ ?7 f
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    
39. (setq num (1+ num))
    ) k: J8 {: r4 M
40. )
    9 H( ?& n9 o. W0 `5 V4 x
41. (vlax-release-object doc)
    
42. (vlax-release-object APP)
    
43. )
    
44. (prompt "\n所选目录中未有任何图形!!")
    
45. )
    
46. (setvar "acadlspasdoc" OLDLSP)
    
47. ;;恢复系统变量值

复制代码

PS:下次发布包含代码的帖子,请使用格式符,否则代码中会有乱码,别人无法复制,也就没人理你了
& x3 P7 d; Z4 L3 J3 N
你在使用中出现过这个对话框吗?
, S% u; E& y" T8 E; w1 |如果出现了,在其中选择相应目录即可.
如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

我的CAD已经安装ET工具且运行时也出现版主说的对话，也选择了目录，只是此程序只对所选择的目录下存在的dwg文件进行查找，而对于所选择目录下的子目录或子目录下的子目录内的dwg文件不进行查找，我觉得此程序存着这点不足，往往对下级目录及下下级目录遍寻查找dwg文件却又很有必要，若有十级的子目录再一级一级去选目录有些显麻烦了，再者此程序不能记忆刚选过的目录，操作略显麻烦，所以请版主及各位lisp大师们帮帮忙修改一下程序，使之可以遍寻选择目录及其子目录下的所有dwg文件，谢谢！
# {2 L, H3 V9 h附件中上传原程序。

1. (arxload "acetutil.arx" NIL)
   $ l' ?' {4 r- R+ g0 Y
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   5 H3 R3 w1 d- C. c
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   
5.   ;;主程序定义
   
6.   (setq OLDECHO (getvar "cmdecho"))
   
7.   ;;保存系统变量值
   
8.   (setvar "cmdecho" 0)
   0 M( @! G* n2 ?& l& W4 ~
9.   (setq        path
   . f* P* v' }* I, y
10.          (strcat
    , V2 m- G* o/ B3 P
11.            (vl-string-right-trim
    
12.              "\"
    
13.              (strcase (acet-ui-pickdir
    0 O! x. g& x. @# y
14.                         "选择目录"
    
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16.                         "批量修改"
    
17.                       )
    2 V% Z! K8 X' [1 |4 z1 m: p2 w
18.              )
    
19.            )
    ) A: H! j+ @( I' Z1 L
20.            "\"
    
21.          )
    
22.   )
    
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24.   ;;保存系统变量值
    
25.   (setvar "acadlspasdoc" 0)
    * ^% K, T  b! ?4 K5 R  o
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    
27.   (setq num 0)
    
28.   (if (/= dwgname NIL)
    
29.     (progn
    2 `8 t. {8 y$ i6 d/ h
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    
31.       (repeat (length dwgname)
    
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    ' j9 H( }5 I% L- C# l  V, p9 V
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34.                                         ;打开图形并获
    ! x1 ^) d. e% S+ ?0 \4 a; N8 Q
35.         得其对象
    9 v' k' M8 n% k/ U: g
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    ) x0 ^( s, S: ?4 [, u
37.         ;; …
    
38.         ;; …
    % v: O8 K) J  o" C
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    
40.         (setq num (1+ num))
    6 Z' l3 G5 a' W
41.       )
    . R4 k5 u; O, ^7 W) p
42.       (vlax-release-object doc)
    
43.       (vlax-release-object APP)
    
44.     )
    8 v& P* Z+ X" O' x: E# j
45.     (prompt "\n所选目录中未有任何图形!!")
    , o  m, c6 Z0 ]# w
46.   )
    
47.   (setvar "acadlspasdoc" OLDLSP)
    , `* {3 i/ ]' D+ _3 E$ r4 F& `  \
48.   ;;恢复系统变量值
    
49.   (setvar "cmdecho" OLDECHO)
    ' S  r9 `( `' r; \
50.   ;;恢复系统变量值
    
51.   (princ)
    / v( y- W7 |/ \0 W8 v  ^
52. )

复制代码