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

rc21

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

! d0 ~  i* I2 G, y7 D6 [" j5 _
(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
% D; N3 v; y) Z(vl-load-com)
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
% r# ~/ c) Q; W );;主程序定义
! h4 ~+ U  s  G8 m8 J; S/ _6 j(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
(setvar "cmdecho" 0)
' j3 G4 |2 P8 q2 N" o; ] (setq path
& g" @4 w# w7 w7 c+ B! J1 X (strcat
(vl-string-right-trim
"\\"
0 S0 s9 O$ h- X# l (strcase (acet-ui-pickdir
"选择目录"
(vl-string-right-trim "\\" (getvar "dwgprefix"))
: ]8 K* R( P+ T2 v "批量修改"
)
)
)
"\\"
8 a/ T1 Q: C# ]4 |4 e) U6 k )
)
(setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
' Z0 m/ k7 r: x(setvar "acadlspasdoc" 0)
* j& d+ d8 _: y% z" z (setq dwgname (vl-directory-files path "*.DWG"))
(setq num 0)
) X4 ~) @# l) n6 R! T' S# f% V (if (/= dwgname NIL)
(progn
6 @" D: c- P, _! ~) a' g1 c (setq APP (vlax-get-acad-object));获得Acad 对象
(repeat (length dwgname)
(setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
$ j7 K' _& u3 H5 ^% C/ P (setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
6 \( S1 p3 y5 {- @9 |: [8 g: V 得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
;; …
;; …
# l6 d( q0 a. O' f(vla-close doc :vlax-false);关闭图形(不检查是否保存)
(setq num (1+ num))
)
(vlax-release-object doc)
(vlax-release-object APP)
)
$ F8 v* o4 V; h# M (prompt "\n所选目录中未有任何图形!!")
) r5 T, L% G. ^9 v )
& h8 h# }. r# H  J! k  q( ]7 n+ j7 {! m (setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
$ a# b1 l: x+ x(princ)
)

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   % B% R7 _2 a; C+ e/ ?2 z- n
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   . x( K( H4 M' q- F
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   3 c. J4 n- H) m: x! f4 P
5. ;;主程序定义
   
6. (setq OLDECHO (getvar "cmdecho"))
   + t9 @! ^0 v2 U- v9 ?
7. ;;保存系统变量值
   
8. (setvar "cmdecho" 0)
   ) _4 G' V+ h! s
9. (setq path
   
10. (strcat
    
11. (vl-string-right-trim
    
12. "\"
    
13. (strcase (acet-ui-pickdir
    5 s+ F8 l, B1 Y3 E" y
14. "选择目录"
    - m; q0 ]* e! R! j* a- w5 ~( N0 [
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    " f6 r9 `) `1 Q# f# s
16. "批量修改"
    " d+ J1 G( M8 i; r
17. )
    
18. )
    7 o8 B# _! g2 i' F9 P: m/ P1 H$ V
19. )
    0 ^& F4 X$ u  w  i; E" g- C
20. "\"
    
21. )
    + A. X, P$ @7 h  t7 F7 @5 G2 i! W
22. )
    
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24. ;;保存系统变量值
    
25. (setvar "acadlspasdoc" 0)
    % W4 o( U* ~% u+ Y6 K4 H
26. (setq dwgname (vl-directory-files path "*.DWG"))
    % X# d3 K- |5 _+ r/ V  H8 h( q$ @
27. (setq num 0)
    
28. (if (/= dwgname NIL)
    
29. (progn
    
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    $ Q7 J  G% i$ v4 J: H- G0 \0 O
31. (repeat (length dwgname)
    8 v1 }2 p/ g4 x
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34. ;打开图形并获得其对象
    
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    ; z, h6 q) I+ `) f
36. ;; …
    / p# s$ M: U" V& N( Q8 U
37. ;; …
    3 b1 k5 q. a5 y
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    
39. (setq num (1+ num))
    
40. )
    1 B( K; {, _5 ]2 D5 g
41. (vlax-release-object doc)
    6 e& p" d. M# g, L: B/ G
42. (vlax-release-object APP)
    ( f( Z/ \  T( a6 c
43. )
    8 S5 u  N/ }! U
44. (prompt "\n所选目录中未有任何图形!!")
    
45. )
    
46. (setvar "acadlspasdoc" OLDLSP)
    
47. ;;恢复系统变量值

复制代码

PS:下次发布包含代码的帖子,请使用格式符,否则代码中会有乱码,别人无法复制,也就没人理你了

; l6 Z3 t9 _" R& m! S3 e2 g你在使用中出现过这个对话框吗?
如果出现了,在其中选择相应目录即可.
& Y* ^8 \" r' \2 R如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

1. (arxload "acetutil.arx" NIL)
   
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   " ]/ V4 c" B* q- v, y8 ~+ G0 U
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   " c  r& N, x% c/ z
5.   ;;主程序定义
   
6.   (setq OLDECHO (getvar "cmdecho"))
   
7.   ;;保存系统变量值
   / ?3 E, _0 c/ p+ C) e% U) c
8.   (setvar "cmdecho" 0)
   - `) r% ^4 ^. |+ H5 F
9.   (setq        path
   1 R" N6 d6 t5 v& }: @8 m
10.          (strcat
    + l% ]6 Z6 g' E
11.            (vl-string-right-trim
    4 Y8 M/ B  l: C& `% J4 S
12.              "\"
    
13.              (strcase (acet-ui-pickdir
    3 ?; n5 K7 j3 ]5 K' u% Q
14.                         "选择目录"
    : _7 s& O: K; X, @& C, R  F
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    ) a3 C; E+ x3 ^# B
16.                         "批量修改"
    / S/ H6 M1 h8 H7 M" t
17.                       )
    
18.              )
    7 z' v* t/ O$ t
19.            )
    3 f1 P) _* T9 E/ j  n
20.            "\"
    
21.          )
    ' m! E, S1 ]1 z
22.   )
    
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24.   ;;保存系统变量值
    ; p( z) A7 w) V# D' d
25.   (setvar "acadlspasdoc" 0)
    / Z( I5 \! V6 R8 I
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    3 `; i" F' p) R$ l: J- s8 t
27.   (setq num 0)
    6 B! U- f7 e8 r6 a" Q/ B
28.   (if (/= dwgname NIL)
    * o+ B* B) S$ t! e
29.     (progn
    " P1 ]- @& K9 H
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    9 ]0 {+ E: N6 {* h6 v( T
31.       (repeat (length dwgname)
    ; F$ _3 p- t8 ?, l1 F
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    & h: q) z* n. v
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    / Q  J6 Q9 z8 a) @7 d5 z3 G. ~
34.                                         ;打开图形并获
    , d! G9 I+ k3 w& `) ?+ k1 G
35.         得其对象
    . m( y  b+ i2 ?; w) ^4 [
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    ) R' T4 o$ X- w+ o- S
37.         ;; …
    
38.         ;; …
    6 i0 W+ u. V8 Q+ b3 V
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    
40.         (setq num (1+ num))
    
41.       )
    
42.       (vlax-release-object doc)
    
43.       (vlax-release-object APP)
    ) h0 D" H; m* N+ O
44.     )
    " @- m  O; _/ q/ s% V* @4 X  y
45.     (prompt "\n所选目录中未有任何图形!!")
    ' X  H; B" u; E8 ]- b" _- R
46.   )
    4 W+ V9 x- V; H; f4 O
47.   (setvar "acadlspasdoc" OLDLSP)
    ; z1 {0 ~' x/ E. t
48.   ;;恢复系统变量值
    , J9 E6 Y% U4 s0 f" ]
49.   (setvar "cmdecho" OLDECHO)
    
50.   ;;恢复系统变量值
    6 z: _* z! n- ?+ Z$ B) D2 |
51.   (princ)
    & K* b6 n  r) I% G3 @5 c
52. )

复制代码