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

rc21

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

: M% ~, Y% H8 L(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
(vl-load-com)
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
/ U) h& l' @) t" a3 E2 Y );;主程序定义
9 ^0 E! u9 i5 L6 R* I! |(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
& ^$ S" C4 c2 N$ N( _(setvar "cmdecho" 0)
(setq path
$ A7 X9 d# O- r" B: q- V (strcat
(vl-string-right-trim
"\\"
(strcase (acet-ui-pickdir
"选择目录"
& m; d, s: S$ _: Z- c0 d+ y& u (vl-string-right-trim "\\" (getvar "dwgprefix"))
" \/ `& e( L  ?3 A2 V" n6 D "批量修改"
+ Q5 l: }( \* a2 j, ~. g )
)
)
"\\"
)
)
(setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
0 Y: _4 p- u' c0 A/ d9 Z1 ~(setvar "acadlspasdoc" 0)
(setq dwgname (vl-directory-files path "*.DWG"))
# G% o3 `2 G+ F1 F9 l (setq num 0)
# N$ ?5 y8 T4 J. Z. j (if (/= dwgname NIL)
(progn
# f* M; b3 }  I# Q6 D5 s! O (setq APP (vlax-get-acad-object));获得Acad 对象
(repeat (length dwgname)
(setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
/ t8 J% u9 c' b4 l# _& n( Q0 S (setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
6 A# A& d$ y9 J6 C;; …
;; …
(vla-close doc :vlax-false);关闭图形(不检查是否保存)
! O: i# n$ Q- L- v  g& e (setq num (1+ num))
)
' W( E' V" C! s- \ (vlax-release-object doc)
(vlax-release-object APP)
) v5 P0 L# g: ~0 x+ i% y )
(prompt "\n所选目录中未有任何图形!!")
3 B- y8 ]; P0 l' n- u% D8 e )
(setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
) w, }* ]) G: [6 c* V(princ)
5 \! ?8 ?8 H3 ] )

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   . v5 m% L/ Q' I" E4 J. a
2. ;;需要相应版本的ET（Express Tools）工具支持
   ' F% c) y2 d) Z; x# j; A* z4 t
3. (vl-load-com)
   4 i7 T2 ]0 w' o( u6 h' C
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   & B) v) R# I+ F2 l7 n
5. ;;主程序定义
   
6. (setq OLDECHO (getvar "cmdecho"))
   ) A' R0 B8 Z8 W2 O, E* r
7. ;;保存系统变量值
   
8. (setvar "cmdecho" 0)
   
9. (setq path
   
10. (strcat
    - A2 j% A! H0 y/ p" P
11. (vl-string-right-trim
    ; I: B+ @1 z; ]  k1 N% j5 C
12. "\"
    
13. (strcase (acet-ui-pickdir
    
14. "选择目录"
    & ?, q- Y6 |7 S$ W
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    2 w; H0 ^8 h3 f5 j( N* @1 V' ?. D
16. "批量修改"
    
17. )
    # K7 Z7 N( d: n4 ?2 L/ j6 k
18. )
    
19. )
      p4 `9 D. O: Q9 t
20. "\"
    
21. )
    - N; G9 J+ A! v6 S9 n( r; ]' m
22. )
    9 {8 [- ?- h- X" C5 }3 Y
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    / D! R# b. Z% \  j6 v
24. ;;保存系统变量值
    - |7 }# ~' o3 z# \+ G4 t" x
25. (setvar "acadlspasdoc" 0)
    4 G: \2 b0 N7 ^! |
26. (setq dwgname (vl-directory-files path "*.DWG"))
    
27. (setq num 0)
    # N8 L0 v$ ^0 Z, b' M9 }% h: S
28. (if (/= dwgname NIL)
    
29. (progn
    ) f6 o0 b0 R& @' ?' J, d
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    0 W$ d7 x( _% h3 c
31. (repeat (length dwgname)
    
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    : D  D- {9 r  U9 I' n) {( I2 e; U
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    5 A$ P- }, K, V
34. ;打开图形并获得其对象
    
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    3 Q) N5 w  x' o& W
36. ;; …
    ( O- u: S& S3 x0 K5 X2 O7 Q6 g5 c
37. ;; …
    & K) a$ k/ ]& N
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    0 L# u; W+ l$ k5 m2 r
39. (setq num (1+ num))
    
40. )
    
41. (vlax-release-object doc)
    
42. (vlax-release-object APP)
    
43. )
    
44. (prompt "\n所选目录中未有任何图形!!")
    * n4 L5 ]/ E7 n! b
45. )
    
46. (setvar "acadlspasdoc" OLDLSP)
    + c6 V. [1 Y$ {& E1 \
47. ;;恢复系统变量值

复制代码

PS:下次发布包含代码的帖子,请使用格式符,否则代码中会有乱码,别人无法复制,也就没人理你了
# [- `7 S' E& p" X
+ t  y- U; K3 F% S# s) [0 W你在使用中出现过这个对话框吗?
如果出现了,在其中选择相应目录即可.
8 X  ^" U* x3 n, E+ q如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

1. (arxload "acetutil.arx" NIL)
   8 D- k/ f- Z7 L% M: x' S" y
2. ;;需要相应版本的ET（Express Tools）工具支持
   3 ?* a8 Y# q1 _1 C
3. (vl-load-com)
   
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   
5.   ;;主程序定义
   ) d+ z( [$ o8 [; B, {" g
6.   (setq OLDECHO (getvar "cmdecho"))
   
7.   ;;保存系统变量值
   8 C9 q) s  _! t" d1 }
8.   (setvar "cmdecho" 0)
   " w+ M2 s  x" Q, Y5 D; c
9.   (setq        path
   , k# _1 i  Z- d( m6 n, _, X
10.          (strcat
    * J; U1 g/ ]( P  _8 H4 c: C
11.            (vl-string-right-trim
    2 o# q! i8 L9 p- h# N9 q& i
12.              "\"
    ( W# N1 r$ A- A
13.              (strcase (acet-ui-pickdir
    
14.                         "选择目录"
    
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16.                         "批量修改"
    
17.                       )
    
18.              )
    / M* e1 A7 K3 X: l2 d
19.            )
    / k  u+ e9 C' G6 y# m! J& v# H
20.            "\"
    
21.          )
    1 a) N! M: Q3 @
22.   )
    6 b( j& x+ r1 y% k6 L6 ~, @
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    ( T5 \: L. |( Q# F3 ?1 I; e
24.   ;;保存系统变量值
    & r. s) X& w6 n5 y
25.   (setvar "acadlspasdoc" 0)
    
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    
27.   (setq num 0)
    
28.   (if (/= dwgname NIL)
    0 w9 |2 U3 B. z, ?7 p. ]* i
29.     (progn
    
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    
31.       (repeat (length dwgname)
    
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    1 {6 V/ c: e5 l. V+ X( r6 T$ r' M
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    2 P! B  e5 O: A, f
34.                                         ;打开图形并获
    1 [4 m+ t  F7 K" K# R) s8 [
35.         得其对象
    
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    / ~( E+ ?# |1 P: ~8 T9 y
37.         ;; …
    
38.         ;; …
    1 V4 j8 d6 j' J% M, S
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    6 L$ J( o$ w" ?( ?9 Z! C1 d9 V: a
40.         (setq num (1+ num))
    & u& Q$ l/ {' L) L/ S* k
41.       )
    
42.       (vlax-release-object doc)
    : _& S  U, M+ x9 o% E1 c
43.       (vlax-release-object APP)
    7 R( u/ ~' |1 P" f5 g9 I+ A
44.     )
    
45.     (prompt "\n所选目录中未有任何图形!!")
    
46.   )
    ; p9 `: t0 a$ ^5 [6 I
47.   (setvar "acadlspasdoc" OLDLSP)
    
48.   ;;恢复系统变量值
    ) g/ O6 }8 _& J6 }* H6 w
49.   (setvar "cmdecho" OLDECHO)
    " M7 Y: M- x* o2 ^4 i6 e
50.   ;;恢复系统变量值
    
51.   (princ)
    8 H; L8 n; x6 c
52. )

复制代码