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

rc21

下面是在网上找的一段图纸批量处理程序，经使用发现只能在所选择的根目录查找dwg文件，对于子目录的dwg文件却不能查找到，因本人不懂LISP也就无法修改，请大师们帮帮忙，给改改这个段程序，使之不论是选择的根目录还是此根目录下的子目录也能查找到所有dwg文件，在此先谢过！！
. e- Z: R- f( C
' [" d/ `  ^8 h+ Q5 a! R$ W5 w- }
(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
- F" T  z' U1 d) R1 n0 n(vl-load-com)
6 y% Q, \; _" E* P9 ~" V8 }- y) J (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
9 e. [; H+ }) \4 T/ `(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
(setvar "cmdecho" 0)
2 Z! A4 |) a, i( u9 | (setq path
4 r- i8 d$ `% k/ k (strcat
(vl-string-right-trim
"\\"
(strcase (acet-ui-pickdir
"选择目录"
(vl-string-right-trim "\\" (getvar "dwgprefix"))
"批量修改"
)
)
)
( h" R% j. K+ s* x9 o "\\"
1 P, z7 Y/ {& z1 p* D; Q )
)
' P( s1 @* g/ r  l (setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
5 P3 P( d* Y) k" m8 R# S: r5 a( k(setvar "acadlspasdoc" 0)
(setq dwgname (vl-directory-files path "*.DWG"))
4 D% A1 ?% H  M" b/ e6 A (setq num 0)
(if (/= dwgname NIL)
(progn
(setq APP (vlax-get-acad-object));获得Acad 对象
(repeat (length dwgname)
1 M; d, e+ b* y5 } (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
(setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
3 T1 T( U* u  }; N 得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
8 ^( l. P1 k9 p! K;; …
;; …
! w! z4 M" [; s6 }(vla-close doc :vlax-false);关闭图形(不检查是否保存)
- B) ?; r6 k1 A! a( q. V (setq num (1+ num))
& l9 `/ i5 C/ z; N3 r )
, q0 J' H6 @' O: \4 C (vlax-release-object doc)
(vlax-release-object APP)
)
/ a6 i6 u/ H& y" a1 c$ o) s (prompt "\n所选目录中未有任何图形!!")
)
(setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
# N* a1 E, [/ ~5 R(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
* ]& G2 O& E* f6 Y! X7 ]" A(princ)
6 ~+ K* O+ P7 @2 e/ B )

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   . G7 `! n0 R* ~. F  {- F
2. ;;需要相应版本的ET（Express Tools）工具支持
   1 F# |& }( [$ F4 L, I6 k
3. (vl-load-com)
   ! r. K& d3 r7 L1 x! q& y6 ?
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   
5. ;;主程序定义
   
6. (setq OLDECHO (getvar "cmdecho"))
   
7. ;;保存系统变量值
   6 J, b& g4 @8 T" M
8. (setvar "cmdecho" 0)
   
9. (setq path
   
10. (strcat
    ; E+ w/ @( _, Z+ p9 N# T2 X
11. (vl-string-right-trim
    
12. "\"
    7 X/ v7 [$ y' {
13. (strcase (acet-ui-pickdir
    * ~0 f0 Q# H" u; O2 e) o3 Z
14. "选择目录"
    - R! l/ E$ S/ y+ e0 N1 S9 f; |2 ]
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16. "批量修改"
    + j, M8 o) b; s7 d# k$ P
17. )
    
18. )
    & E  e, O# ^$ N
19. )
    
20. "\"
    4 ]0 |8 ^: ?8 N; o) s6 t% V
21. )
    / i, u" a; M2 U9 e% C
22. )
    0 j# D# i3 q1 Q. F2 f3 h
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    - e  |5 p/ a% P2 _- J
24. ;;保存系统变量值
    8 M4 H$ ^4 n4 x: v$ M9 V
25. (setvar "acadlspasdoc" 0)
    3 ?7 w" ?: H4 m+ s% y1 e
26. (setq dwgname (vl-directory-files path "*.DWG"))
    
27. (setq num 0)
    
28. (if (/= dwgname NIL)
    
29. (progn
    
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    0 Y- c$ n8 h0 }0 h5 I2 t/ E! C
31. (repeat (length dwgname)
    
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    $ U- O3 o7 }" |* S" Z/ K4 V) M1 v1 ~: p' Q
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    % E2 d6 V' Q+ Y' O, B9 A
34. ;打开图形并获得其对象
    
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    % a# T# ^( q$ G; V# b
36. ;; …
    * O& U. v7 I4 R7 \
37. ;; …
    
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    ; B' e9 m/ q# u) g& U4 [; h/ }
39. (setq num (1+ num))
      X9 h+ I' j3 o. k2 u, u/ I9 l; H) h
40. )
    
41. (vlax-release-object doc)
    6 `$ _; M  _. B
42. (vlax-release-object APP)
    4 L+ u" g2 y/ v* V4 X4 J3 i
43. )
    
44. (prompt "\n所选目录中未有任何图形!!")
    
45. )
    ! I5 _! Z3 v" t5 P
46. (setvar "acadlspasdoc" OLDLSP)
    ) L' q6 ?- k0 E# C
47. ;;恢复系统变量值

复制代码

PS:下次发布包含代码的帖子,请使用格式符,否则代码中会有乱码,别人无法复制,也就没人理你了
5 x+ h! A9 V5 I4 ]
你在使用中出现过这个对话框吗?
如果出现了,在其中选择相应目录即可.
3 K2 o) [( m8 g9 f  p5 T如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

1. (arxload "acetutil.arx" NIL)
   $ X( h" }8 J1 N5 Q
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   
5.   ;;主程序定义
   & o/ U& W4 p, ~+ I8 x/ P
6.   (setq OLDECHO (getvar "cmdecho"))
   6 @! Q( i# p0 g! l
7.   ;;保存系统变量值
   
8.   (setvar "cmdecho" 0)
   
9.   (setq        path
   
10.          (strcat
    
11.            (vl-string-right-trim
    
12.              "\"
    9 V. ^0 g+ u; y+ ~; R
13.              (strcase (acet-ui-pickdir
    
14.                         "选择目录"
    
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16.                         "批量修改"
    / K# o* G( A- o% F  K
17.                       )
    " k/ L! t$ R' X) E  F! t
18.              )
    . b' M' h+ Q% V  H; ~7 q
19.            )
    # h0 i3 q; Q5 Y+ h  n  N
20.            "\"
    2 B$ L# T; O3 V9 r% R% X8 {" p
21.          )
    
22.   )
    2 ^4 u, d. f+ K! y
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24.   ;;保存系统变量值
    
25.   (setvar "acadlspasdoc" 0)
    & u' }' u4 ^7 X: g6 `
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    
27.   (setq num 0)
    ( ^! ]5 q" g) ~& c; g
28.   (if (/= dwgname NIL)
    
29.     (progn
    - @5 q3 v+ w) m9 n8 [& t8 y' K
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    
31.       (repeat (length dwgname)
    4 l/ T$ F. ]3 x) [, g! f) j& J
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34.                                         ;打开图形并获
    
35.         得其对象
    + J* B: e) x/ S7 f8 \5 d
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    4 e. }' a9 s' I/ o5 c
37.         ;; …
    ( Q# I6 m! s+ {, l& d. ?5 ^
38.         ;; …
    
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    " _1 b! b5 w6 g. g
40.         (setq num (1+ num))
    
41.       )
    
42.       (vlax-release-object doc)
    3 |4 x7 d2 \& t* K' L
43.       (vlax-release-object APP)
    
44.     )
    ) `) `0 R. g5 ~: G7 ]0 C: y1 T
45.     (prompt "\n所选目录中未有任何图形!!")
    
46.   )
    6 ^2 k2 s  h, y2 K+ ^
47.   (setvar "acadlspasdoc" OLDLSP)
    0 w$ S- r1 |) c
48.   ;;恢复系统变量值
    
49.   (setvar "cmdecho" OLDECHO)
    ( q+ R9 p. V7 h* ]; t/ o. r9 m
50.   ;;恢复系统变量值
    . C3 h( X8 B+ |% _: y
51.   (princ)
    ' B+ K' |2 X6 v4 m5 {5 M
52. )

复制代码