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

rc21

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

7 a, e  a4 z- ~8 k3 m
* M' B- N3 @/ `0 ?) T' R; S  L3 e(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
0 \8 X2 o; ~( |7 E9 `+ X(vl-load-com)
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
# C( s1 j3 X& T" k0 }(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
(setvar "cmdecho" 0)
(setq path
8 o' r: Z4 ~0 W9 {8 a/ D (strcat
(vl-string-right-trim
, m% n- R& Y/ q) T; _ "\\"
0 ?+ _9 ?$ d. w# |5 [9 }8 O (strcase (acet-ui-pickdir
"选择目录"
(vl-string-right-trim "\\" (getvar "dwgprefix"))
- U2 H% S. l! n0 \ "批量修改"
)
3 S  {; O- l: Z$ d )
)
"\\"
8 j7 o2 R0 E$ Z) B1 l6 Z; ?" P; z )
)
(setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
(setvar "acadlspasdoc" 0)
8 e, K9 J& [" N) k4 H# r: }5 n; M (setq dwgname (vl-directory-files path "*.DWG"))
: p4 f( o6 |  J4 f! { (setq num 0)
% L' t" q* i; k2 y' A$ d2 W (if (/= dwgname NIL)
(progn
(setq APP (vlax-get-acad-object));获得Acad 对象
(repeat (length dwgname)
/ t; m; u0 Z. `6 R4 `. N' Q) X1 a (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
% W: D7 l7 Z6 l8 z* A (setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
得其对象
% l7 ^' P: w7 [4 ?;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
;; …
& J, c4 ~7 p+ m( r2 g& A: y5 Z;; …
8 t# A; A7 i: @; g& X* f% o5 a(vla-close doc :vlax-false);关闭图形(不检查是否保存)
(setq num (1+ num))
% Q; a; k$ D- s )
# g1 f# G& l& f( {- p$ u2 m0 O (vlax-release-object doc)
(vlax-release-object APP)
)
1 x7 B1 N) A: N* d (prompt "\n所选目录中未有任何图形!!")
; ^4 Q  _: J( u0 `1 _, p )
(setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
8 k8 K, Z* B3 l* ^(princ)
)

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   7 t8 @, o7 G4 [6 t0 o. |8 S
5. ;;主程序定义
   
6. (setq OLDECHO (getvar "cmdecho"))
   1 h5 a  _" j  S" y2 `) E2 Y
7. ;;保存系统变量值
   
8. (setvar "cmdecho" 0)
   
9. (setq path
   
10. (strcat
    8 d1 ~9 U3 {, q
11. (vl-string-right-trim
    
12. "\"
    3 A& ?1 L0 z7 v, O* ?# M
13. (strcase (acet-ui-pickdir
    
14. "选择目录"
    
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    - e& z* H8 y, Y8 S4 R- X
16. "批量修改"
    4 k) `* D5 c, T" B$ h: [
17. )
    8 ^6 ~! P2 o, {2 j. X9 P* B
18. )
    " V  _0 X6 D6 U
19. )
    
20. "\"
    2 c! a. U' T- G+ K/ R; F' X# P# S
21. )
    
22. )
    1 c: L  U0 |( ~$ u: p
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24. ;;保存系统变量值
    # {% `6 e. S% V
25. (setvar "acadlspasdoc" 0)
    % l+ ~. g" b0 _4 L. p! `
26. (setq dwgname (vl-directory-files path "*.DWG"))
    
27. (setq num 0)
    
28. (if (/= dwgname NIL)
    ! ?- @: F* P( H2 f5 I& U
29. (progn
    . n9 A( v0 E4 w0 I# P  V
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    1 ~1 d/ c' T  z: w
31. (repeat (length dwgname)
      K" u) s# p; C1 z  _1 Q3 p
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34. ;打开图形并获得其对象
    
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    
36. ;; …
    * u% N2 Z( R. X
37. ;; …
    5 O5 w4 ~5 R. a4 E! ^1 G
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    & T! B- Y! g2 }2 X7 w6 d
39. (setq num (1+ num))
    ) F- s4 o/ X. |) o* y* r7 c, _4 O
40. )
    
41. (vlax-release-object doc)
    
42. (vlax-release-object APP)
    9 n% _3 P2 O* U7 C( }0 S1 d
43. )
    7 ^2 K' n; l% z  I
44. (prompt "\n所选目录中未有任何图形!!")
    ( e7 M0 @, J- M( `" m; m
45. )
    
46. (setvar "acadlspasdoc" OLDLSP)
    
47. ;;恢复系统变量值

复制代码

PS:下次发布包含代码的帖子,请使用格式符,否则代码中会有乱码,别人无法复制,也就没人理你了
) ^' a: s+ _& g3 p3 @
你在使用中出现过这个对话框吗?
如果出现了,在其中选择相应目录即可.
如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

1. (arxload "acetutil.arx" NIL)
   , R. c( S7 ?6 G
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   , Q& {* E$ i& Q  `9 E. F' h
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   8 C6 h$ L( W- x9 F
5.   ;;主程序定义
   / \4 w: s. y: t2 Y( Z" D
6.   (setq OLDECHO (getvar "cmdecho"))
   - x# G) I! v6 P
7.   ;;保存系统变量值
   
8.   (setvar "cmdecho" 0)
   
9.   (setq        path
   2 i) L. b  V) F( m6 I
10.          (strcat
    * x6 f$ p  N& o  z- T3 g
11.            (vl-string-right-trim
    
12.              "\"
    4 q' x8 \' B& S8 E
13.              (strcase (acet-ui-pickdir
    
14.                         "选择目录"
    4 ]2 ?% i/ G6 c+ k/ n4 z
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16.                         "批量修改"
    4 n3 v$ n) @/ H5 Q
17.                       )
    
18.              )
    . \: c4 }" ^: [
19.            )
    
20.            "\"
    
21.          )
    9 T' U0 H' ]: p- L
22.   )
    
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    5 j# W7 |' y6 A4 z2 I* I* o
24.   ;;保存系统变量值
    
25.   (setvar "acadlspasdoc" 0)
    
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    
27.   (setq num 0)
    
28.   (if (/= dwgname NIL)
    ) J$ A+ U1 D4 u+ z  r9 I
29.     (progn
    
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    : I8 ^2 Q1 ?) x* E& |, {
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.         得其对象
    
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    
37.         ;; …
    
38.         ;; …
    
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    
40.         (setq num (1+ num))
    
41.       )
    
42.       (vlax-release-object doc)
      n3 H6 H4 S! h/ O
43.       (vlax-release-object APP)
      Q' U, v) D/ X) a# v
44.     )
    
45.     (prompt "\n所选目录中未有任何图形!!")
    ( Q$ U  m# y6 _* S* {4 E
46.   )
    
47.   (setvar "acadlspasdoc" OLDLSP)
    8 ~  o/ A" ^& k2 l& z
48.   ;;恢复系统变量值
    % h; w* Q4 |; }; z, S5 L! q+ U( {
49.   (setvar "cmdecho" OLDECHO)
    
50.   ;;恢复系统变量值
      Q$ ~6 d7 G. g9 a& T
51.   (princ)
    2 [# u' t7 l9 a
52. )

复制代码