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

rc21

下面是在网上找的一段图纸批量处理程序，经使用发现只能在所选择的根目录查找dwg文件，对于子目录的dwg文件却不能查找到，因本人不懂LISP也就无法修改，请大师们帮帮忙，给改改这个段程序，使之不论是选择的根目录还是此根目录下的子目录也能查找到所有dwg文件，在此先谢过！！
0 U" q. g) H6 G( O* @/ \
& t: J$ a4 u' x' }& I; O
(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
(vl-load-com)
2 A9 G) Z% t2 c. S$ J; s (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
6 }+ l, v. L$ e( D4 w(setvar "cmdecho" 0)
8 s% G2 B, J0 Y* e1 u (setq path
& f5 @% N3 x  z* T (strcat
(vl-string-right-trim
& \% A  G9 G* N7 C2 x2 w  [ "\\"
; o* U/ \% v! X- ^# m (strcase (acet-ui-pickdir
0 |9 j% F7 m( U  ?* A% C! ^. Z1 f! ` "选择目录"
# A4 d, g. D8 y6 d/ R9 W (vl-string-right-trim "\\" (getvar "dwgprefix"))
"批量修改"
4 ]% ]( Z, _0 s  ` )
)
+ j/ M1 T6 Q" S2 ^0 [3 N )
"\\"
9 d% b6 _0 |9 ~, [* M( y )
6 |* M9 U1 J  Q1 m0 o& ~5 k )
; m; S( {' s3 L) \' [ (setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
(setvar "acadlspasdoc" 0)
6 ~# |4 h8 A% v* P4 X. e( E (setq dwgname (vl-directory-files path "*.DWG"))
" g: x6 L. ]0 `# w& G (setq num 0)
(if (/= dwgname NIL)
) o7 ?6 g2 }, F4 q (progn
(setq APP (vlax-get-acad-object));获得Acad 对象
7 F3 o& H/ T+ o1 K$ T9 a9 P9 X(repeat (length dwgname)
3 p+ b0 P9 d8 r (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
4 Z1 L: K7 k9 u" U- J( U  d (setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
1 ~2 b$ I5 }0 z! B+ ^ 得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
0 E! d3 [/ P8 V" d$ b2 \( |;; …
;; …
! I0 `+ @9 h3 w(vla-close doc :vlax-false);关闭图形(不检查是否保存)
(setq num (1+ num))
% ~. V8 e* H( B )
+ y( D$ S9 q8 s9 W! f9 T: e* O (vlax-release-object doc)
- d9 C9 ]1 y0 n+ ~ (vlax-release-object APP)
/ u2 u" |8 _5 N4 Q- L )
& E8 I# r5 T! i9 D" G (prompt "\n所选目录中未有任何图形!!")
)
+ _8 z/ l7 E) N$ B7 J' ?5 d (setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
. i( _0 b( h' M: L2 N( T9 J(princ)
)

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   4 Y/ L" u' q; [: h
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
     R2 O  k9 m+ `: o: }
5. ;;主程序定义
   
6. (setq OLDECHO (getvar "cmdecho"))
   ! y) y, i9 \: k  K) b& ]
7. ;;保存系统变量值
   . A5 g. `4 c' O/ }$ d; W* n( y
8. (setvar "cmdecho" 0)
   ' ^0 [6 e; r, S8 T
9. (setq path
   
10. (strcat
    " V2 H$ w7 R" c* ^+ z( n
11. (vl-string-right-trim
    
12. "\"
    
13. (strcase (acet-ui-pickdir
    $ v. G/ ~4 m# L! S) X! c9 d* x
14. "选择目录"
    
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    * N9 r, x/ H9 \; E
16. "批量修改"
    / C0 j( v" L! K# \  ~. Z7 w; M% s
17. )
    , n1 n& Y3 d/ L
18. )
    
19. )
    
20. "\"
    
21. )
    - x4 i, f2 l0 d, y
22. )
    7 q+ @! |  \" n6 m, |8 x
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24. ;;保存系统变量值
    5 l1 s2 l) @! i* v' b+ c
25. (setvar "acadlspasdoc" 0)
    
26. (setq dwgname (vl-directory-files path "*.DWG"))
    
27. (setq num 0)
    
28. (if (/= dwgname NIL)
    
29. (progn
    : b7 z) P6 W) o( P4 T4 g
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    
31. (repeat (length dwgname)
    3 m5 i# I) H+ J" X* `, V
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34. ;打开图形并获得其对象
    9 b4 M5 h) Q+ J! O5 ^
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
      v; r  a( `$ A; g7 d
36. ;; …
    5 ]& E6 I3 d6 _  T, Z
37. ;; …
    
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    
39. (setq num (1+ num))
    
40. )
    $ r2 |: E3 M; t0 x% z/ t
41. (vlax-release-object doc)
    
42. (vlax-release-object APP)
    
43. )
    6 @, I- V3 v. K0 U' {- j
44. (prompt "\n所选目录中未有任何图形!!")
    + Q8 a$ p  u( v- B
45. )
    6 C& f' T+ q9 R" @- p
46. (setvar "acadlspasdoc" OLDLSP)
    
47. ;;恢复系统变量值

复制代码

PS:下次发布包含代码的帖子,请使用格式符,否则代码中会有乱码,别人无法复制,也就没人理你了
6 K4 M7 f" T4 |& O& _- o, P$ c
你在使用中出现过这个对话框吗?
如果出现了,在其中选择相应目录即可.
& h7 \: o# l& m/ r/ N2 l如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

1. (arxload "acetutil.arx" NIL)
   
2. ;;需要相应版本的ET（Express Tools）工具支持
     P! A' ~% E- H- }8 m, B
3. (vl-load-com)
   # Z( Y1 x, t. f6 P0 q  q
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   
5.   ;;主程序定义
   
6.   (setq OLDECHO (getvar "cmdecho"))
   % O  x  ]* r% I5 |
7.   ;;保存系统变量值
   6 v3 ~4 U' B3 E5 H7 a1 t
8.   (setvar "cmdecho" 0)
   : ~9 U2 W' Y) d2 J& s) Z! `
9.   (setq        path
   4 l+ _5 r% K* A, W
10.          (strcat
    
11.            (vl-string-right-trim
    * T6 L1 x5 ]% x8 ]3 ~0 g
12.              "\"
    * t  F" d* }7 q8 P5 a' Z
13.              (strcase (acet-ui-pickdir
    2 ^+ i" R9 V* n: s2 G- S! h! L
14.                         "选择目录"
    5 N0 W: T- B' O& d% q  x
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16.                         "批量修改"
    
17.                       )
    $ @5 Y" h  V. ^5 I& k3 k! U
18.              )
    + w& T- b# x( k5 }" \7 d- t
19.            )
    7 ]/ C  X' j: h" N- ^: k
20.            "\"
    
21.          )
    ! Y' q6 e  `; i0 D
22.   )
    , U: z% q; d4 ?6 d4 m: N+ ]& p
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    & ~* v3 s& @  Q7 Z0 P, N7 D
24.   ;;保存系统变量值
    
25.   (setvar "acadlspasdoc" 0)
    
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    
27.   (setq num 0)
    $ h4 t- r; @5 J) ^7 R
28.   (if (/= dwgname NIL)
    . \2 M% D5 k7 X6 R/ ~* e5 h
29.     (progn
    : P1 _3 S4 Y  ~# s5 {0 x- r
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    
31.       (repeat (length dwgname)
    ! h1 Z' o* Y2 \* ^/ c$ M9 T% v; V
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34.                                         ;打开图形并获
    
35.         得其对象
    
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    ! a; e# r! o* U2 z$ B& C
37.         ;; …
    ( o& A- q7 n! M& i: x- J
38.         ;; …
    
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    
40.         (setq num (1+ num))
    & s% e; s% o! T; N$ Q- ?
41.       )
    % n% x; f+ }9 f: ~6 i
42.       (vlax-release-object doc)
    
43.       (vlax-release-object APP)
    7 ^1 w1 \; w: `8 B1 M% b3 O
44.     )
    $ O9 R7 z( O+ J3 ^2 K1 S' F
45.     (prompt "\n所选目录中未有任何图形!!")
    
46.   )
    
47.   (setvar "acadlspasdoc" OLDLSP)
    
48.   ;;恢复系统变量值
    
49.   (setvar "cmdecho" OLDECHO)
    $ r% M: Z( H$ D6 J1 o& Y# v
50.   ;;恢复系统变量值
    
51.   (princ)
    
52. )

复制代码