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

rc21

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

! \9 g0 Q" `# h(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
(vl-load-com)
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
" q7 J5 ~, ~4 S# C6 Y# p! }(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
# g& K% ~; n0 V* y9 V- {2 z8 A/ j(setvar "cmdecho" 0)
5 y9 z& N& o( D (setq path
(strcat
(vl-string-right-trim
"\\"
3 W9 n5 N/ l+ ^ (strcase (acet-ui-pickdir
"选择目录"
( {- F& m: ?; J (vl-string-right-trim "\\" (getvar "dwgprefix"))
% P" p) c4 M1 r7 c2 Y/ _+ c) z9 c* L "批量修改"
4 Z* T, I% p3 J7 k$ X5 v1 E )
)
& c* l# {4 `1 o  @) b6 T )
+ a# u3 [; B) X/ o/ z "\\"
8 p# T! ?8 o3 I" n! _ )
; P" q3 y9 v3 ^2 H )
# P. m6 _! s3 P* z3 q8 z* a (setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
(setvar "acadlspasdoc" 0)
(setq dwgname (vl-directory-files path "*.DWG"))
. M. s% I" C+ t; n (setq num 0)
(if (/= dwgname NIL)
6 D2 b3 ]+ Q, u$ k! B+ ?( ` (progn
8 A3 M4 b/ O3 k  t0 g1 } (setq APP (vlax-get-acad-object));获得Acad 对象
(repeat (length dwgname)
5 \% a" U+ H8 c% o (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
(setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
得其对象
6 q7 p1 L0 l. c1 v3 e. G;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
2 [. i5 ~& g) I/ C8 h1 L;; …
;; …
! V! k  i* @% L0 z(vla-close doc :vlax-false);关闭图形(不检查是否保存)
/ H: _4 L1 J7 t# G (setq num (1+ num))
# g1 l4 F* W4 j% K9 e )
: ~& R# E1 }, e (vlax-release-object doc)
/ n& a6 w3 Y" L- ^$ E3 I. N (vlax-release-object APP)
4 w- p/ v% r( t4 F4 j! H )
(prompt "\n所选目录中未有任何图形!!")
  y" `' z5 q' K: m) U4 [ )
(setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
6 s# V' a: C0 \% S(princ)
7 Z3 X$ \- N4 }1 A, @5 D )

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   & r4 y) m" ]  z$ n9 b/ _7 q& j
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   ) o" y: |9 }1 c
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   
5. ;;主程序定义
   ; _9 T1 L$ _; {
6. (setq OLDECHO (getvar "cmdecho"))
   2 l5 L( v# g' w+ K9 ~7 ?
7. ;;保存系统变量值
   . a& h+ l4 ~6 k. N5 q
8. (setvar "cmdecho" 0)
   
9. (setq path
   , t+ F$ x( y) a6 F) `0 \4 z
10. (strcat
    
11. (vl-string-right-trim
    / X- v$ t  {, E" ~& e
12. "\"
    ( G; \/ e- Z7 G
13. (strcase (acet-ui-pickdir
    2 _9 J- s% m/ }. E8 d
14. "选择目录"
    5 [0 a8 g- B0 v  T
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    , y# h1 x$ J; H# i2 s2 H- `) b
16. "批量修改"
    
17. )
    & @$ w8 X) U* \$ P. q# `/ u5 I% y
18. )
    " \+ Q4 F  y: L+ Q7 ]8 e+ c) ?) h
19. )
    
20. "\"
    ) r/ x4 `' o* ^, d  ?- x
21. )
    # y5 Z% I) K* C; R% e) w0 N
22. )
    + ~# w1 k3 S2 l3 N# n$ _$ P. J
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    . a, Y  B$ M# |2 h- {. Y
24. ;;保存系统变量值
    
25. (setvar "acadlspasdoc" 0)
    * O/ Z- i; O+ Z- Q$ [
26. (setq dwgname (vl-directory-files path "*.DWG"))
    " D- q, {& F' e6 A2 R4 U
27. (setq num 0)
    4 e5 P/ J* n: f: c" R. Q
28. (if (/= dwgname NIL)
    
29. (progn
    
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    
31. (repeat (length dwgname)
    % F2 H( D5 {/ q% ^
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34. ;打开图形并获得其对象
    
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    $ z4 ~' L; w  D6 R5 b4 M
36. ;; …
    
37. ;; …
    
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    
39. (setq num (1+ num))
    
40. )
    / f5 e+ O7 X0 V* f' {" L) ^) I
41. (vlax-release-object doc)
    * ]2 k& @3 l5 S" ]6 w3 r
42. (vlax-release-object APP)
    / a% r5 [7 w% |" T7 S$ n4 t
43. )
    0 s0 T/ p  Z$ @# N1 h5 v
44. (prompt "\n所选目录中未有任何图形!!")
    
45. )
    
46. (setvar "acadlspasdoc" OLDLSP)
    
47. ;;恢复系统变量值

复制代码

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

你在使用中出现过这个对话框吗?
如果出现了,在其中选择相应目录即可.
8 w# n7 g9 E1 s" [如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

1. (arxload "acetutil.arx" NIL)
   % S: C' ~' z/ Q3 n8 z
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   ! s, U: V2 ~% \$ G7 G
5.   ;;主程序定义
   + X* @- k4 U- d0 C* i0 b
6.   (setq OLDECHO (getvar "cmdecho"))
   % V! Y, _* ^- @
7.   ;;保存系统变量值
   6 g" [& O. V1 \' J) Q
8.   (setvar "cmdecho" 0)
   
9.   (setq        path
   6 q4 X# g/ ]& Z. E4 y$ C
10.          (strcat
    
11.            (vl-string-right-trim
    
12.              "\"
    ! ]" s2 ?1 D$ k& k, @  E
13.              (strcase (acet-ui-pickdir
    9 x+ b0 z6 i/ j4 [) g( G
14.                         "选择目录"
    / }2 [! X9 n# ]. P
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    1 c. `) v# {, e0 V3 L
16.                         "批量修改"
    
17.                       )
    
18.              )
    
19.            )
    . {' h9 \% t: E( ]: y
20.            "\"
    
21.          )
    
22.   )
    * t, I; C) a3 h# g5 d
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    ! l; ?1 e2 \* e/ N* H3 N3 x
24.   ;;保存系统变量值
    % w: X: P0 \) g( a9 x
25.   (setvar "acadlspasdoc" 0)
    7 A; t+ O" L2 o$ s
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    
27.   (setq num 0)
    
28.   (if (/= dwgname NIL)
    
29.     (progn
    
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    
31.       (repeat (length dwgname)
    
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    3 _, W! J' J* W
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34.                                         ;打开图形并获
    
35.         得其对象
    
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    # \7 Z3 o; r  u- Q
37.         ;; …
    # y9 P6 d: h: s; Y
38.         ;; …
    
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    / F0 b, G! ~  @0 ^6 T. o  |
40.         (setq num (1+ num))
    ; _* \' n1 V- f5 c
41.       )
    % f  s% z! K8 n" o
42.       (vlax-release-object doc)
    ' z! ]9 g# [* s/ h( I
43.       (vlax-release-object APP)
    
44.     )
    
45.     (prompt "\n所选目录中未有任何图形!!")
    9 \' U# g& W$ Y6 F, l
46.   )
    ; ~2 |& a3 J2 `% @( |6 W# z  Z
47.   (setvar "acadlspasdoc" OLDLSP)
    
48.   ;;恢复系统变量值
    
49.   (setvar "cmdecho" OLDECHO)
      M6 `3 M- v2 v. ?5 A
50.   ;;恢复系统变量值
    
51.   (princ)
    
52. )

复制代码