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

rc21

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

(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
% U) T1 F& Z7 R1 d2 u# z0 Z(vl-load-com)
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
/ J+ h1 T4 S4 ~2 d(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
0 c; b  u5 i# Q3 J2 x1 Y, N0 s(setvar "cmdecho" 0)
(setq path
+ H, r# ?( d6 [ (strcat
(vl-string-right-trim
- K8 |; i3 D, u( d1 ` "\\"
(strcase (acet-ui-pickdir
"选择目录"
(vl-string-right-trim "\\" (getvar "dwgprefix"))
"批量修改"
)
)
)
0 F+ W! Y1 B- b6 Y# l! S, i "\\"
5 N- _1 q, ^  W* H2 o9 O4 c, S. K )
)
& ~6 A" X# H) D (setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
(setvar "acadlspasdoc" 0)
" i* ~$ H/ g5 C+ W4 t (setq dwgname (vl-directory-files path "*.DWG"))
2 k+ F! V6 R' ?" V- t- z (setq num 0)
+ y9 X% r2 L4 ]/ e4 l0 N (if (/= dwgname NIL)
5 H7 J. n# X% S; C+ u4 ` (progn
5 H9 D1 u( J" a- X5 T4 W- h, {& h (setq APP (vlax-get-acad-object));获得Acad 对象
(repeat (length dwgname)
(setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
(setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
% Q9 ]" a: h5 r! X( k* x 得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
5 a5 G0 n) `9 m) I% N& `& m& B;; …
: ?1 E; c4 t; R3 S5 o;; …
- o, i. g2 m! E# W, t(vla-close doc :vlax-false);关闭图形(不检查是否保存)
(setq num (1+ num))
8 p; o3 p( x( X! @ )
. R( p7 x; j- D* n% @ (vlax-release-object doc)
(vlax-release-object APP)
)
(prompt "\n所选目录中未有任何图形!!")
)
; e' `3 }6 Q* a3 I( i, l (setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
; x7 ~3 D& c7 b& y6 t(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)
   1 i+ o# M5 I+ g1 O. l( I/ \: S
5. ;;主程序定义
   
6. (setq OLDECHO (getvar "cmdecho"))
   
7. ;;保存系统变量值
   ! E8 S0 [  {7 C& [+ }
8. (setvar "cmdecho" 0)
     y; o; [& Y# B& A9 o
9. (setq path
   & O; W% S# e) z6 `2 m/ I/ V
10. (strcat
    4 H8 L) `0 p3 V1 _
11. (vl-string-right-trim
    
12. "\"
    / H  h- v0 ?, H$ F$ q& u
13. (strcase (acet-ui-pickdir
    8 t  B1 G, P# C/ \
14. "选择目录"
      \3 a0 t' B% u$ l" g
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    - N6 z' ^4 [8 L# @
16. "批量修改"
    & I5 f) m: ]; o' c
17. )
    0 P% P! @- \: `4 e- k2 {3 s4 S4 @
18. )
    6 i$ i' p$ X9 W% j" n0 z
19. )
    
20. "\"
    / b- n5 R3 p4 {3 Z) Y) D
21. )
    7 H6 N, ?( r' S' C' ^) X6 _
22. )
    
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24. ;;保存系统变量值
    
25. (setvar "acadlspasdoc" 0)
    
26. (setq dwgname (vl-directory-files path "*.DWG"))
    
27. (setq num 0)
    ( ^0 x7 `) m* P+ i
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))))
    ! ]; ]. m" u  R' l1 O, Z( P
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    0 j  c3 _' c9 q
34. ;打开图形并获得其对象
    
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    
36. ;; …
    9 h! b6 c  Y( E
37. ;; …
    9 ^* r9 J+ {) Q) ~
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    
39. (setq num (1+ num))
    
40. )
    
41. (vlax-release-object doc)
    . ~  v7 ^& U7 a7 {& u
42. (vlax-release-object APP)
    
43. )
    
44. (prompt "\n所选目录中未有任何图形!!")
    & Q4 E% Y" x7 A4 ?' N
45. )
    / _! @4 c1 \# e4 |+ d1 h8 X
46. (setvar "acadlspasdoc" OLDLSP)
    9 j4 Z/ `/ ?" W- Z" x) A  u% d% p
47. ;;恢复系统变量值

复制代码

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

: [$ O5 c5 u3 A  g* I你在使用中出现过这个对话框吗?
3 L1 a( f5 x, R3 f! Z如果出现了,在其中选择相应目录即可.
: }- W* j" H7 f9 ?$ @4 s如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

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)
   % s/ Z- P$ h8 C( v% |1 @, C4 o
5.   ;;主程序定义
   
6.   (setq OLDECHO (getvar "cmdecho"))
   ( o0 c8 k$ N$ R, |
7.   ;;保存系统变量值
   , h$ N+ I: I  }$ F% L# p- [
8.   (setvar "cmdecho" 0)
   ) c, D" C8 R% K, c( j" z1 V' o/ m
9.   (setq        path
   
10.          (strcat
    
11.            (vl-string-right-trim
    
12.              "\"
    
13.              (strcase (acet-ui-pickdir
    
14.                         "选择目录"
    
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    - ]3 I6 f, J9 w+ L: Q' N
16.                         "批量修改"
    
17.                       )
    
18.              )
    
19.            )
    9 _- K5 d' r8 u! x; @
20.            "\"
    7 |) L& V& d! o3 P& a( i5 s- ?
21.          )
    
22.   )
    
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24.   ;;保存系统变量值
    ( d. A6 ^0 w; ~2 |7 v: ~
25.   (setvar "acadlspasdoc" 0)
    
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    $ N0 q, K+ {. j! `  d7 `
27.   (setq num 0)
    * j% w: x& Q% k, o8 ^; Y2 B5 Q
28.   (if (/= dwgname NIL)
    
29.     (progn
    
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    5 h9 E2 ?3 ?9 m) }- U
31.       (repeat (length dwgname)
    - e1 L" z! z. O
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34.                                         ;打开图形并获
    
35.         得其对象
    , Z' D3 x2 f% M6 x8 M1 l  ]% L  ?
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    
37.         ;; …
    6 r& g6 h/ Y0 U- Q& J' @# p, C
38.         ;; …
    
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    9 t! e0 Y  G3 m
40.         (setq num (1+ num))
    
41.       )
    
42.       (vlax-release-object doc)
    / r4 O* Z  k( s% m0 O2 I% T( F8 }
43.       (vlax-release-object APP)
    , Y, K' _) n" f3 C# u* g
44.     )
    
45.     (prompt "\n所选目录中未有任何图形!!")
    * g5 d: ]+ W+ M9 W( x
46.   )
    4 d: {% |+ e' z5 l' F+ P3 J
47.   (setvar "acadlspasdoc" OLDLSP)
    # {3 o" o" O& a1 {+ U7 l+ Q) s
48.   ;;恢复系统变量值
    
49.   (setvar "cmdecho" OLDECHO)
    7 h- P% e0 U  m( R0 r
50.   ;;恢复系统变量值
    & I, j$ n2 v/ C0 p
51.   (princ)
    & [5 p; Z1 a8 z$ n
52. )

复制代码