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

rc21

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


(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
1 U$ Y, J9 q( L9 a) b; n$ K(vl-load-com)
/ @6 X2 ~- z5 |: u. F (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
3 \  w: o0 H: a* _( e/ T$ }8 k- i );;主程序定义
8 O  c& ]# j) w8 X(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
/ ~% S4 X7 F3 }3 W, D2 z% ?9 Y! A! O(setvar "cmdecho" 0)
7 d( `( ?6 I; @+ o* X  t (setq path
(strcat
(vl-string-right-trim
"\\"
(strcase (acet-ui-pickdir
"选择目录"
(vl-string-right-trim "\\" (getvar "dwgprefix"))
"批量修改"
)
)
)
"\\"
)
)
- x! R9 p- s9 C (setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
, p, Z6 z1 ]- v* X(setvar "acadlspasdoc" 0)
(setq dwgname (vl-directory-files path "*.DWG"))
8 Q, X6 F, d2 V2 ~( w8 h (setq num 0)
% j1 r% V# t3 w% q9 y( O* m1 L, L (if (/= dwgname NIL)
(progn
(setq APP (vlax-get-acad-object));获得Acad 对象
(repeat (length dwgname)
7 Y+ R) Y, T3 q2 u5 k" h (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
( P% f9 d- ~9 g/ e/ I3 M2 H (setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
;; …
;; …
(vla-close doc :vlax-false);关闭图形(不检查是否保存)
0 Y# _( l  m, }+ Q2 F7 _6 c (setq num (1+ num))
6 T9 C1 f4 p' }, q2 j! P )
(vlax-release-object doc)
- y' _3 s, U5 o, ~/ P( u (vlax-release-object APP)
( c5 K7 r- ]- S6 ]5 D )
  @5 ?# ^- k6 ~# P (prompt "\n所选目录中未有任何图形!!")
; U8 M  u; y% V4 ?) \- H" D: \$ s )
(setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
  N' Z4 C% A3 p& F6 I( ?1 v8 k(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
+ Y3 n( S0 j0 D6 n! n$ V(princ)
- E9 ^' h9 i! g3 r/ I1 c4 a )

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   3 y' q4 |- S5 b
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   . K! H7 X$ D0 G* N9 ?
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   
5. ;;主程序定义
   
6. (setq OLDECHO (getvar "cmdecho"))
   . G% {# O! e, P  @2 w
7. ;;保存系统变量值
   3 V! }, L5 p9 W& K. w9 z$ Z! ]
8. (setvar "cmdecho" 0)
   
9. (setq path
   
10. (strcat
    " Y& r. r% C: y; ]- S' l
11. (vl-string-right-trim
    
12. "\"
    
13. (strcase (acet-ui-pickdir
    
14. "选择目录"
    
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16. "批量修改"
    ! `% P6 u& a- s2 I& A  Z9 v4 k
17. )
    
18. )
    
19. )
    
20. "\"
    
21. )
    , U7 ~  \: h9 [/ ^* r6 D
22. )
    1 W2 K0 s& D3 E: ^* V
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    ; e$ ^$ A& S! E  I5 C  V
24. ;;保存系统变量值
    
25. (setvar "acadlspasdoc" 0)
    
26. (setq dwgname (vl-directory-files path "*.DWG"))
    + d0 Q- e! q. q9 o
27. (setq num 0)
    2 S6 i4 M: b8 P9 Q) m
28. (if (/= dwgname NIL)
    $ L( u. r1 b" l5 Z/ F) v4 c
29. (progn
    ) }: r$ C& k! D" w1 A( y
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    
31. (repeat (length dwgname)
    
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    2 Y5 V% }" V' L% S: r' G+ K. j
34. ;打开图形并获得其对象
    - E2 @0 N; c% J" O
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    
36. ;; …
    
37. ;; …
    5 N3 n0 e! ~2 ?5 W+ P7 j! I# ?# ?
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    
39. (setq num (1+ num))
    3 M7 ^+ _- t& O$ x& z# e
40. )
    
41. (vlax-release-object doc)
    & N- d6 X- C- O, G! P& y( {/ L
42. (vlax-release-object APP)
    7 O  f+ }$ g% B1 N- a2 S* H8 m
43. )
    
44. (prompt "\n所选目录中未有任何图形!!")
    
45. )
    * e9 b- E& g0 `/ S
46. (setvar "acadlspasdoc" OLDLSP)
    ( Z3 x7 }- f. |. H) q
47. ;;恢复系统变量值

复制代码

PS:下次发布包含代码的帖子,请使用格式符,否则代码中会有乱码,别人无法复制,也就没人理你了
7 r9 G* z1 Q% k8 `
你在使用中出现过这个对话框吗?
0 \8 i! Z: ]/ U$ Z) k* Q: c2 O如果出现了,在其中选择相应目录即可.
如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

1. (arxload "acetutil.arx" NIL)
   
2. ;;需要相应版本的ET（Express Tools）工具支持
   , j. V; ?5 N4 F
3. (vl-load-com)
   
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   
5.   ;;主程序定义
   + l3 Z9 ^" c' A
6.   (setq OLDECHO (getvar "cmdecho"))
   % J$ `$ ]0 x& a: A: V+ p) P
7.   ;;保存系统变量值
   
8.   (setvar "cmdecho" 0)
   
9.   (setq        path
   
10.          (strcat
    , X. B, I* O# \; z  x* O; b1 t
11.            (vl-string-right-trim
    6 s1 S9 f8 l$ b; @6 m
12.              "\"
    
13.              (strcase (acet-ui-pickdir
    
14.                         "选择目录"
    . j* F5 z, I1 z% z3 S
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    ' h6 P  z% i- p& m# Y
16.                         "批量修改"
    ! G  v0 P$ H0 R& {$ ^! u  C
17.                       )
    
18.              )
    & F. e1 ?- e  ^7 i$ D
19.            )
    
20.            "\"
    " \7 A" c2 F; `# f+ Y* I
21.          )
    
22.   )
    : \( Y% h! D6 X6 V( b
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    8 h5 S$ E1 ?- K7 d
24.   ;;保存系统变量值
    
25.   (setvar "acadlspasdoc" 0)
    
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    
27.   (setq num 0)
    3 \9 C6 \. O& K  c
28.   (if (/= dwgname NIL)
    5 V* q% T2 a5 Z7 V& O3 T% C
29.     (progn
    
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    
31.       (repeat (length dwgname)
    
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    5 M2 V4 G# k# J; k. F
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34.                                         ;打开图形并获
    
35.         得其对象
    
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    
37.         ;; …
    
38.         ;; …
    1 \2 q2 ?7 |, O4 M- |4 I# w. i
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    
40.         (setq num (1+ num))
    ( H( V5 u6 N9 N  ]* c! c6 a
41.       )
    
42.       (vlax-release-object doc)
    
43.       (vlax-release-object APP)
    
44.     )
    
45.     (prompt "\n所选目录中未有任何图形!!")
    
46.   )
      ^5 M  r6 Y2 U) s
47.   (setvar "acadlspasdoc" OLDLSP)
    
48.   ;;恢复系统变量值
    . X; n% z/ z1 \! j; N/ g1 b3 E
49.   (setvar "cmdecho" OLDECHO)
    9 A* ~: I! t" H0 J( U$ i
50.   ;;恢复系统变量值
    - M6 C% t) {; Q  w+ q: V- y
51.   (princ)
    
52. )

复制代码