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

rc21

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


(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
5 ?2 I% x- k: D: X(vl-load-com)
5 A* j2 H  }: b4 ~( u8 K8 z (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
5 ?  t5 r, u  u# G# I+ o. c) J(setvar "cmdecho" 0)
' `: E6 `% I* ?: R (setq path
(strcat
(vl-string-right-trim
"\\"
( T" o# Y1 h. L0 g% g! g& c& z (strcase (acet-ui-pickdir
; I) d; U4 S$ }' I* G# O4 W7 @+ R( }, w "选择目录"
(vl-string-right-trim "\\" (getvar "dwgprefix"))
"批量修改"
)
$ J& E' Q/ m& a/ {7 D0 l- |+ v )
)
"\\"
5 I* }, Z/ d' X8 m )
)
(setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
(setvar "acadlspasdoc" 0)
(setq dwgname (vl-directory-files path "*.DWG"))
" Z. E$ B5 {  X' v2 k (setq num 0)
(if (/= dwgname NIL)
(progn
(setq APP (vlax-get-acad-object));获得Acad 对象
(repeat (length dwgname)
(setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
7 D* C- r# l5 R7 r8 c# _: h (setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
  C. |7 q* C# d+ E# Z 得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
# o9 V( |, j4 w;; …
;; …
- k" s, h4 B) a% R5 O, Z: U6 S) W6 H(vla-close doc :vlax-false);关闭图形(不检查是否保存)
(setq num (1+ num))
)
' R+ _) {/ V; m8 {/ p (vlax-release-object doc)
6 i, n. L8 E  @# _% x: D (vlax-release-object APP)
)
3 _6 f# O6 \( ]9 y$ v (prompt "\n所选目录中未有任何图形!!")
. j! f; t6 c! D* G )
(setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
2 A' G& M; V& y9 p(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
0 ~* b4 o" x2 w: M(princ)
)

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   5 g. v1 a! f; S$ Q: e! Z' _
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   6 g( I& `$ g7 ]* V7 ]
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   # [- ^# o% m. f+ H; U% r" K
5. ;;主程序定义
   
6. (setq OLDECHO (getvar "cmdecho"))
   
7. ;;保存系统变量值
   
8. (setvar "cmdecho" 0)
   ( q$ Q, b  c3 Y- _* T, x4 M4 c9 N
9. (setq path
   
10. (strcat
    ' A; c/ _5 a' K3 P9 G
11. (vl-string-right-trim
    5 e' {6 L/ _1 I+ \
12. "\"
    / p$ }6 C- a) {1 b1 ~& m7 g
13. (strcase (acet-ui-pickdir
    " h, M/ i4 t; A2 A( l5 R0 w9 I
14. "选择目录"
    6 O, f, S/ j8 v: b5 o. x
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16. "批量修改"
    
17. )
    
18. )
    
19. )
    
20. "\"
    
21. )
    0 r, a$ S, L) ~% T' S
22. )
      @) Y' L4 z$ M
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    4 W3 w7 b8 |( O: T3 c6 b/ z2 ?
24. ;;保存系统变量值
    
25. (setvar "acadlspasdoc" 0)
    
26. (setq dwgname (vl-directory-files path "*.DWG"))
    3 M& h  Z1 Q+ i: u* z3 P
27. (setq num 0)
    
28. (if (/= dwgname NIL)
    
29. (progn
    + j+ _1 q/ e6 }1 `6 i  S" |1 k) q
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    # G, |- b! P- a, h$ d, A
31. (repeat (length dwgname)
    9 ^5 Z7 ^+ C$ q2 ?. A+ q; R" [' g  \
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    : y2 q8 C9 ?4 X6 R' X  Q& d5 x
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    9 Q8 t' P' z7 i9 S2 w
34. ;打开图形并获得其对象
    
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    
36. ;; …
    
37. ;; …
    
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    
39. (setq num (1+ num))
    
40. )
    
41. (vlax-release-object doc)
    
42. (vlax-release-object APP)
    ; h) f/ t/ J4 O( E: V4 B
43. )
    
44. (prompt "\n所选目录中未有任何图形!!")
    
45. )
      W( j% }# K5 o& _) T8 C! J& y
46. (setvar "acadlspasdoc" OLDLSP)
    
47. ;;恢复系统变量值

复制代码

PS:下次发布包含代码的帖子,请使用格式符,否则代码中会有乱码,别人无法复制,也就没人理你了
! q8 x3 J! \) a$ {# E$ U5 {& O
; V8 P7 v. }  J+ P; s0 J你在使用中出现过这个对话框吗?
如果出现了,在其中选择相应目录即可.
如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

1. (arxload "acetutil.arx" NIL)
   " x+ t  C7 {8 ]4 [' D( c7 U! Z
2. ;;需要相应版本的ET（Express Tools）工具支持
   3 N; j8 d1 W- `+ w8 O
3. (vl-load-com)
   
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   9 Q# d+ c; i5 ~; c: b* ~7 l. W* E/ U
5.   ;;主程序定义
   4 k. I: n% n: y. P
6.   (setq OLDECHO (getvar "cmdecho"))
   
7.   ;;保存系统变量值
   $ X) ^  \  h4 e6 ^; t
8.   (setvar "cmdecho" 0)
   " `' P' F: w0 E; ]. |5 o
9.   (setq        path
   
10.          (strcat
    . W% q6 `' v3 g+ X; A& B5 w/ V
11.            (vl-string-right-trim
    - H; l4 O7 _# `
12.              "\"
    2 o; ~2 ~- e9 `5 D# `6 \
13.              (strcase (acet-ui-pickdir
    
14.                         "选择目录"
    
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    0 D7 ?7 R8 h/ N5 f. T
16.                         "批量修改"
    1 o  }0 v2 K% b2 E
17.                       )
    
18.              )
      D: J9 s, u- v0 a3 b
19.            )
    3 v! S  ~! o; ?, m5 l
20.            "\"
    2 d. C4 K# m* u9 x
21.          )
    9 V3 K0 U. i0 s' j2 X
22.   )
    
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24.   ;;保存系统变量值
    7 p# @& ~% V# y
25.   (setvar "acadlspasdoc" 0)
    
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    ; [6 J, U6 l2 m) U4 l
27.   (setq num 0)
    8 L  i6 I9 c3 z. `
28.   (if (/= dwgname NIL)
    
29.     (progn
    
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    
31.       (repeat (length dwgname)
    
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    4 q6 s% q# |  Q$ r7 F* o
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34.                                         ;打开图形并获
    6 G+ ~: `' F3 s- g8 c5 Y8 s
35.         得其对象
    
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    & }% `  x5 |7 [$ z9 A7 R
37.         ;; …
    ' i2 J( _8 m4 T1 g
38.         ;; …
    
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    ' m, `- L) J+ \$ Z
40.         (setq num (1+ num))
    - D) u* j& a- [
41.       )
    . ^4 u" A' K& S# d- `3 h. c3 Q
42.       (vlax-release-object doc)
    5 b5 f! [1 Y6 w0 h$ e
43.       (vlax-release-object APP)
    + ]8 ^2 A( ?4 _. w: Q# g7 H9 _
44.     )
    . A/ _0 A; l( F. I
45.     (prompt "\n所选目录中未有任何图形!!")
    : ~$ ~# J: w3 \2 ]' u
46.   )
    
47.   (setvar "acadlspasdoc" OLDLSP)
    
48.   ;;恢复系统变量值
    
49.   (setvar "cmdecho" OLDECHO)
    6 u6 N/ _# p5 G& ~# b+ S8 x) [
50.   ;;恢复系统变量值
      \$ _; K. c0 `
51.   (princ)
    
52. )

复制代码