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

rc21

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


! e, l# s6 ?8 d. R' o(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
(vl-load-com)
% k9 o. U: A+ J$ } (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
  X+ m$ ~' m1 k) z8 S; k/ }0 @: \$ {(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
9 M; W7 n2 n8 [9 N; S  b(setvar "cmdecho" 0)
(setq path
(strcat
6 j6 \  j) W: v1 ^ (vl-string-right-trim
" R0 N/ ]/ K& d- T "\\"
(strcase (acet-ui-pickdir
) a+ D# b& w2 O "选择目录"
(vl-string-right-trim "\\" (getvar "dwgprefix"))
"批量修改"
3 |& g, {" |4 R% S7 Y )
)
)
, v: U" F/ m2 K/ _ "\\"
)
)
+ h7 W% u2 m( t (setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
8 T/ @6 f7 E, Y5 e6 c! D0 b% m  w+ Z4 s(setvar "acadlspasdoc" 0)
- a! p5 o. h! z- a6 n- @ (setq dwgname (vl-directory-files path "*.DWG"))
(setq num 0)
(if (/= dwgname NIL)
1 C+ X, y) M' T. A  L (progn
) Y9 I) _$ x5 \+ j (setq APP (vlax-get-acad-object));获得Acad 对象
- v/ N9 G0 R4 P  k4 l(repeat (length dwgname)
) H5 `* y7 _9 _/ D (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
( S2 c) _% O+ ~8 R- D3 @  G/ { (setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
6 e' ^2 C4 Z1 w' K* _" X, i 得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
, J* a( J+ L' p% S;; …
;; …
3 J2 Q: B' Y7 r# c" d5 {% r: K8 j(vla-close doc :vlax-false);关闭图形(不检查是否保存)
(setq num (1+ num))
8 W4 U' V$ u5 a2 s0 v2 s$ W8 u )
(vlax-release-object doc)
(vlax-release-object APP)
% `, E! D5 q1 i- v0 l' S+ `, b5 k, F )
(prompt "\n所选目录中未有任何图形!!")
)
" l6 g, l! @/ h$ s6 J+ u" c* ]; P1 e (setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
9 M$ J: t! B/ w(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
: }0 B7 j+ M! {1 @(princ)
)

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   
2. ;;需要相应版本的ET（Express Tools）工具支持
   & }2 o5 B6 ]! T( ?2 y/ s' d/ V  n
3. (vl-load-com)
   ; t3 B! _" V9 w7 X
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   ) P: J7 x7 @; m9 O
5. ;;主程序定义
   , A9 n  C: ?+ p& Z
6. (setq OLDECHO (getvar "cmdecho"))
   
7. ;;保存系统变量值
     a7 ]9 T% A9 W
8. (setvar "cmdecho" 0)
   
9. (setq path
   - |2 L# |2 h0 r/ a
10. (strcat
    
11. (vl-string-right-trim
    
12. "\"
    ' P0 o# i3 m, g9 _. J9 Q/ X
13. (strcase (acet-ui-pickdir
    4 ]$ `% I1 P  i8 |
14. "选择目录"
    
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    * a; z4 K; v0 I% ?
16. "批量修改"
    5 J7 V6 N  d$ \) {
17. )
    9 j" e* e# B) Y+ M
18. )
      [  i4 B9 [' {
19. )
    % a  U5 x' r: g+ N* y# F. C
20. "\"
    
21. )
    
22. )
    2 r( e: J% Q, ?& o6 v9 y
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    * ]; D" x  C/ H, y8 d
24. ;;保存系统变量值
    . J! Y& u) a7 {- e+ P7 z
25. (setvar "acadlspasdoc" 0)
    
26. (setq dwgname (vl-directory-files path "*.DWG"))
    
27. (setq num 0)
    
28. (if (/= dwgname NIL)
    3 C$ L/ O# f: m2 [
29. (progn
    
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))
    + x7 s+ }* o/ n
34. ;打开图形并获得其对象
    9 @, O1 O6 X' ?7 A, }# f( \
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    7 W! v& V. X. Q
36. ;; …
    
37. ;; …
    
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    
39. (setq num (1+ num))
    5 W8 y# z7 F5 v/ o% I3 H
40. )
    & |2 Z) t7 Y$ f
41. (vlax-release-object doc)
    
42. (vlax-release-object APP)
    
43. )
    # e6 b+ @" Q) p, c6 o5 ?/ ~! B2 s/ D
44. (prompt "\n所选目录中未有任何图形!!")
    
45. )
    
46. (setvar "acadlspasdoc" OLDLSP)
    
47. ;;恢复系统变量值

复制代码

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

) [; K, ~* S; p, u- W" b- o你在使用中出现过这个对话框吗?
如果出现了,在其中选择相应目录即可.
如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

1. (arxload "acetutil.arx" NIL)
   
2. ;;需要相应版本的ET（Express Tools）工具支持
   
3. (vl-load-com)
   ) ^& Q( q* o+ L8 B% I
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   1 |( N$ N$ ^. w* I' }
5.   ;;主程序定义
   
6.   (setq OLDECHO (getvar "cmdecho"))
   9 I: g9 l# \% |6 f/ b
7.   ;;保存系统变量值
   ) ?' e9 e3 k& s& O9 a! \: `
8.   (setvar "cmdecho" 0)
   9 d& w$ d4 F- A% Y1 k
9.   (setq        path
   - L% ^- b. E% D; R; l. f
10.          (strcat
    
11.            (vl-string-right-trim
    
12.              "\"
    
13.              (strcase (acet-ui-pickdir
    ) H- i/ B& P, u9 N4 V
14.                         "选择目录"
    " L+ `3 R% H- \; {- b# d
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    $ K) ~4 @( ?- R' u5 d
16.                         "批量修改"
    
17.                       )
    - E9 q& T; q: u4 K, s* q: T- G6 k$ U
18.              )
    0 U- w* A2 L8 s# P0 q+ j; I3 _
19.            )
    
20.            "\"
    
21.          )
    9 v  B; E, C& k1 I# y  ~  o$ T
22.   )
    8 G2 [+ \$ a8 i$ X, m, H
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    8 S/ _) V7 r/ q8 w, Z7 A) l
24.   ;;保存系统变量值
    
25.   (setvar "acadlspasdoc" 0)
    
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    
27.   (setq num 0)
    
28.   (if (/= dwgname NIL)
    
29.     (progn
    , N8 e  J% [- @  z# d5 K/ R* ?) {
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    6 A' ?6 \- H( e5 r1 Q. N
31.       (repeat (length dwgname)
    8 ~0 I2 @. _: ~- b- A7 m' l  ^
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
      S5 V) ?: l5 C5 N
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34.                                         ;打开图形并获
    + V5 b) F5 X5 B* `2 v' A
35.         得其对象
    
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    1 Z* P$ i3 h( z" L# s
37.         ;; …
    / v5 h) s* r+ x7 ]6 l1 ~
38.         ;; …
    1 `0 ~; p- z7 `& j; m/ }
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    0 h; S$ f8 i3 ]; }, q
40.         (setq num (1+ num))
    4 [; x% R( A, V0 }( X* c# [/ I" n' T2 M
41.       )
    1 e7 {3 |% |3 ^
42.       (vlax-release-object doc)
    ! P. I3 d: O' |: O5 A1 i9 y
43.       (vlax-release-object APP)
    . N' {$ Q  g2 p4 D% G1 ]9 A; I
44.     )
    
45.     (prompt "\n所选目录中未有任何图形!!")
    
46.   )
    
47.   (setvar "acadlspasdoc" OLDLSP)
    
48.   ;;恢复系统变量值
    * e. `- v8 q3 i+ [6 h) Z
49.   (setvar "cmdecho" OLDECHO)
    
50.   ;;恢复系统变量值
    
51.   (princ)
    5 a1 O7 r4 d$ r
52. )

复制代码