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

rc21

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

1 V, M7 b$ ]. s5 r(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
% e. |$ c) u7 ](vl-load-com)
& t' M) D9 p' n9 l3 c (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
2 l6 m# Z% \5 @% n+ j );;主程序定义
(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
% l9 e$ Q3 Z9 d3 e. b(setvar "cmdecho" 0)
7 K' `6 R2 h9 \3 M0 Y& D* \( h7 Z: M (setq path
& J$ Q6 P4 t9 C2 p# i (strcat
1 h# i2 \8 z- T  s4 m (vl-string-right-trim
"\\"
, O& E+ F' ?2 j) S6 ] (strcase (acet-ui-pickdir
"选择目录"
(vl-string-right-trim "\\" (getvar "dwgprefix"))
. m" H9 {% J% e) P& q* e "批量修改"
)
  k0 e/ ~( B3 d0 `/ G9 v )
- Q- d  Z* A: C$ n1 f" n )
$ q& E! a6 d& B* G3 b+ r8 V, @/ j "\\"
)
)
% M. @. S" B; R3 Y% l7 n0 @ (setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
$ \  A' c' F- _; s: K4 j5 _1 Z% I: a(setvar "acadlspasdoc" 0)
(setq dwgname (vl-directory-files path "*.DWG"))
(setq num 0)
5 }: q" z; s( P9 }% m/ z (if (/= dwgname NIL)
(progn
: G. J8 M* f! |. Y. U (setq APP (vlax-get-acad-object));获得Acad 对象
! G. I9 |) l) Q- Y) E5 g, I(repeat (length dwgname)
) A0 h2 P) N1 [# c- p" w0 U (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
(setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
得其对象
/ h; u( K. `! a( r4 v;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
* q+ v1 P5 X6 X3 f3 b" G;; …
/ N/ e. P! L" T1 x; b. {1 T;; …
9 D& `& |  p4 w8 O8 B+ C/ b(vla-close doc :vlax-false);关闭图形(不检查是否保存)
(setq num (1+ num))
)
8 h/ U1 N4 ~/ P (vlax-release-object doc)
7 U) ]. u2 I* J$ @' i$ C (vlax-release-object APP)
9 e3 ^7 F4 k$ s. _2 q1 Y9 y )
(prompt "\n所选目录中未有任何图形!!")
( b, ~, T0 m7 n' L' l2 x  |: R )
(setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
3 z2 U! W) K% x1 W9 y(princ)
0 R; O+ `; M+ g+ K5 I' }& ?- I# ^ )

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   , @' o, ?! i) O+ y; R/ b5 q
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 G# {6 K4 ]  o) a9 v; x' k
7. ;;保存系统变量值
   
8. (setvar "cmdecho" 0)
   
9. (setq path
   
10. (strcat
    6 e' o7 ^/ @0 A- Z, _# f7 J
11. (vl-string-right-trim
    ) S( r9 Z- R0 y3 ~$ @! R  T
12. "\"
    , k# X& `. z2 ~2 i
13. (strcase (acet-ui-pickdir
    3 O, G& T/ G6 w: L2 _* T
14. "选择目录"
    
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16. "批量修改"
    
17. )
    
18. )
    
19. )
    
20. "\"
      a* P3 V5 N# j( g
21. )
    0 X7 f  R% b9 C4 A' X! B
22. )
    
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24. ;;保存系统变量值
    3 y  `" s; s/ G- {9 t& b' q6 B  h. e) @
25. (setvar "acadlspasdoc" 0)
    8 r4 l  z" @# I0 P( L
26. (setq dwgname (vl-directory-files path "*.DWG"))
    
27. (setq num 0)
    0 S& c  d5 E9 G, r
28. (if (/= dwgname NIL)
    9 J1 U7 R( C) o) Z/ w5 u
29. (progn
    2 D0 |7 e! Z! h; v
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    7 u8 J/ m* V* {7 A. }4 J. ]
31. (repeat (length dwgname)
    
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34. ;打开图形并获得其对象
    
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    ( ?; p" e7 t6 Q! ~& R
36. ;; …
    & r1 t9 m. J: f9 h) \! L
37. ;; …
    
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    / `# n! E  m! H* o6 U) \! T
39. (setq num (1+ num))
    4 e/ S6 E( e, c3 S. @+ S% B: Y: y
40. )
    6 f2 x( ~2 T7 X
41. (vlax-release-object doc)
    / C+ u) e, y& [6 |8 w; @5 D$ B( P, d$ T
42. (vlax-release-object APP)
    # e, |& V, i7 p8 K# B3 g2 l
43. )
    
44. (prompt "\n所选目录中未有任何图形!!")
    
45. )
    " _/ a: e$ |7 X& v
46. (setvar "acadlspasdoc" OLDLSP)
    ! ?9 v0 D$ W; L+ Q/ K- S
47. ;;恢复系统变量值

复制代码

PS:下次发布包含代码的帖子,请使用格式符,否则代码中会有乱码,别人无法复制,也就没人理你了
2 ^& B( d3 x9 L* z, v
你在使用中出现过这个对话框吗?
" t3 d: ]" `$ ?- [如果出现了,在其中选择相应目录即可.
如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

1. (arxload "acetutil.arx" NIL)
   
2. ;;需要相应版本的ET（Express Tools）工具支持
   % O% M" z: D6 q
3. (vl-load-com)
   
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   ; E- m( i0 Q: I- D# N
5.   ;;主程序定义
   * Q+ o1 L9 d4 _
6.   (setq OLDECHO (getvar "cmdecho"))
   $ R8 s3 M- b+ ?0 ?& E" t& D
7.   ;;保存系统变量值
   
8.   (setvar "cmdecho" 0)
   3 M: @& [  r0 @
9.   (setq        path
   
10.          (strcat
    
11.            (vl-string-right-trim
    
12.              "\"
    
13.              (strcase (acet-ui-pickdir
    
14.                         "选择目录"
    
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    ) {3 B; v$ C/ y
16.                         "批量修改"
    . n3 C! s2 O+ z$ |$ `
17.                       )
    * H0 J, u$ G! ?
18.              )
    9 @/ r8 B; Y0 K# N
19.            )
    
20.            "\"
    
21.          )
    & B: O# p, y6 O8 ?9 e3 _
22.   )
    ) }6 u  [2 Y, E+ G
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24.   ;;保存系统变量值
    
25.   (setvar "acadlspasdoc" 0)
    
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    ' F# r8 A1 Y) g9 i/ ?* S9 _5 `
27.   (setq num 0)
    
28.   (if (/= dwgname NIL)
    . x0 e' P, D1 g. Q  i
29.     (progn
    
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    
31.       (repeat (length dwgname)
    2 L" c  B" O/ d" l7 y
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34.                                         ;打开图形并获
    - e+ S/ o8 v6 u
35.         得其对象
    
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    & N( W' I. W8 K
37.         ;; …
    1 W$ g9 r$ X7 ^% p; F: P2 C1 n
38.         ;; …
    ; g( P1 A9 O. g
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    
40.         (setq num (1+ num))
    & e4 o' O( f3 J$ G9 \" l. ]* B* i
41.       )
    
42.       (vlax-release-object doc)
    
43.       (vlax-release-object APP)
    
44.     )
    
45.     (prompt "\n所选目录中未有任何图形!!")
    
46.   )
    : Q/ m  D7 {+ l0 g. I' x/ G! B
47.   (setvar "acadlspasdoc" OLDLSP)
    / R* l4 f; Y2 B' V& |5 r
48.   ;;恢复系统变量值
    
49.   (setvar "cmdecho" OLDECHO)
    
50.   ;;恢复系统变量值
    
51.   (princ)
    
52. )

复制代码