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

rc21

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

) V0 d, D5 X! t, ?- m4 n
(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
5 E8 q3 H) Q' C2 ~+ e(vl-load-com)
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
(setvar "cmdecho" 0)
(setq path
1 {# V9 }. K' L% j* @4 [; I) a (strcat
(vl-string-right-trim
! Y1 z. S. B0 G "\\"
7 H( t4 |+ u2 F1 H" O  x (strcase (acet-ui-pickdir
"选择目录"
/ f; H; n' j8 s (vl-string-right-trim "\\" (getvar "dwgprefix"))
"批量修改"
5 D/ s! ~9 \7 d( I0 t4 g )
& [4 N" m7 d% D$ q1 a" r/ o6 o )
( v: v& w1 u% t& N% _ )
/ [- U2 m  W. E "\\"
)
( ^. t$ O% x: p& N  Z )
9 E  p3 g" a/ q+ L; Q (setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
(setvar "acadlspasdoc" 0)
(setq dwgname (vl-directory-files path "*.DWG"))
# S% L/ x. u* M8 u3 g (setq num 0)
(if (/= dwgname NIL)
9 S7 s: Z5 V9 _ (progn
(setq APP (vlax-get-acad-object));获得Acad 对象
: ?$ K+ \" N3 P  D8 ?(repeat (length dwgname)
- Y5 {! ]" M* x9 q: n (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
. _5 V- z* [% P7 |0 p& Z) s (setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
0 W1 B1 k7 i# I3 R5 i% s 得其对象
, x: v3 n- t6 L6 o0 _4 d;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
;; …
;; …
(vla-close doc :vlax-false);关闭图形(不检查是否保存)
/ b+ D) r4 X, s; j+ Y2 a (setq num (1+ num))
)
, K& r4 q) u/ l2 R0 {* k (vlax-release-object doc)
) [* ?, P) A& a! T' e7 Q (vlax-release-object APP)
4 }! r! g8 K6 i: }, r/ B( n1 J )
(prompt "\n所选目录中未有任何图形!!")
)
: N! m* o$ P, N2 H9 z$ |  r. z$ v (setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
$ Y& i  O9 }7 W' Q* ^6 d9 g(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
6 T0 Y) u( g/ Z- T* }5 Y; g(princ)
)

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   
2. ;;需要相应版本的ET（Express Tools）工具支持
   . W+ x+ s* U0 o
3. (vl-load-com)
   4 x9 y' f# T% ?2 ?/ P
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   4 p; D- H7 q% E5 O
5. ;;主程序定义
   , P* p7 r6 j0 y2 P6 A. L' k
6. (setq OLDECHO (getvar "cmdecho"))
   8 r; H: a6 a! x4 G  k
7. ;;保存系统变量值
   ' X1 c1 p& k6 }0 N) @5 f+ j
8. (setvar "cmdecho" 0)
   : d+ Z4 @* G" S/ W9 H( ]
9. (setq path
   
10. (strcat
    6 ?7 D% j) j4 k% j2 q: [" U" ~
11. (vl-string-right-trim
    
12. "\"
    
13. (strcase (acet-ui-pickdir
    
14. "选择目录"
    : n. w7 E+ I1 D1 _0 y
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    ( }6 S3 [6 i! @
16. "批量修改"
    
17. )
    
18. )
    
19. )
    
20. "\"
    ; u) O, y4 Q7 B- b# O: ^
21. )
    
22. )
    
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    8 a& K0 `- H. ^2 i, n2 r1 W; a
24. ;;保存系统变量值
    # g" v0 N2 |% |* u
25. (setvar "acadlspasdoc" 0)
    
26. (setq dwgname (vl-directory-files path "*.DWG"))
    
27. (setq num 0)
    . s; ^6 W+ j1 c+ u  R& _1 z# S# w2 W
28. (if (/= dwgname NIL)
    9 M' k. k. E+ I# R7 Q5 O
29. (progn
    8 j+ ~% ^7 h( w  j" ?5 q- \
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    $ I9 p8 P: y( y. N
31. (repeat (length dwgname)
    1 a: G$ z) z/ q
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34. ;打开图形并获得其对象
    0 ^* j- o2 j9 Z6 k
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    
36. ;; …
    8 R, c( [$ b' u& D! M- p
37. ;; …
    
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    
39. (setq num (1+ num))
    
40. )
    8 S4 P8 j5 n" y5 l2 p: @
41. (vlax-release-object doc)
    
42. (vlax-release-object APP)
    $ }# X7 H; h5 R, e
43. )
    
44. (prompt "\n所选目录中未有任何图形!!")
    
45. )
    9 |2 Y+ l* O+ x7 ]' i
46. (setvar "acadlspasdoc" OLDLSP)
    3 B% p5 i1 e9 b' J  p
47. ;;恢复系统变量值

复制代码

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

+ K* E0 l& N' J! T你在使用中出现过这个对话框吗?
如果出现了,在其中选择相应目录即可.
如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

1. (arxload "acetutil.arx" NIL)
   
2. ;;需要相应版本的ET（Express Tools）工具支持
   . K$ R( s4 E0 q+ l
3. (vl-load-com)
   
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   
5.   ;;主程序定义
   ) c9 ~/ u; S* m' B: Q5 y+ e
6.   (setq OLDECHO (getvar "cmdecho"))
   1 }5 ~0 Y( n7 Q8 e& `! x: f5 [
7.   ;;保存系统变量值
   3 q4 }1 Q$ W% ~  K9 H+ B# ^4 }0 p
8.   (setvar "cmdecho" 0)
   5 n$ h2 r! L2 s# g+ c1 B2 M) ]  N
9.   (setq        path
   
10.          (strcat
    
11.            (vl-string-right-trim
    3 Q+ K' D7 |$ n; {; {% M
12.              "\"
    ' W8 X0 @; d* J3 j
13.              (strcase (acet-ui-pickdir
    $ L3 G9 k2 V$ s3 W) [' k8 i
14.                         "选择目录"
    
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16.                         "批量修改"
    
17.                       )
    
18.              )
    
19.            )
    4 F6 ^3 E+ Y  ?
20.            "\"
    
21.          )
    
22.   )
    9 i6 n  o: P: X
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    ! j% b; L- ^- ?4 M, d) K
24.   ;;保存系统变量值
    3 U3 r5 h, i+ K( r' l- a# D& p% \, H# w* @
25.   (setvar "acadlspasdoc" 0)
    + M2 X* Q  {5 B) K
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    
27.   (setq num 0)
    
28.   (if (/= dwgname NIL)
    5 \) V8 K. ~) T* _3 {
29.     (progn
    % O. i( g/ \. p0 ~* Y6 z6 S
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    ( L8 N: ]9 g  O
31.       (repeat (length dwgname)
    ' [; g2 r8 p: @
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    
34.                                         ;打开图形并获
    + d4 S, W& S( w6 x% l4 r
35.         得其对象
    0 F  ^( k! E8 f0 [
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    8 Z: c/ W% n% |* T. ^4 ]
37.         ;; …
    
38.         ;; …
    
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    , K2 K9 i/ Y+ G2 U' A
40.         (setq num (1+ num))
    
41.       )
    3 n1 _. g& D) D7 R7 K- q
42.       (vlax-release-object doc)
    
43.       (vlax-release-object APP)
    ; }0 I* O) J  \4 M, i
44.     )
    % P" ?' g, u4 X9 |# Y( S
45.     (prompt "\n所选目录中未有任何图形!!")
    0 e' _2 a& Q+ m" O. U
46.   )
    
47.   (setvar "acadlspasdoc" OLDLSP)
    & C( z" `, c* K$ R9 z
48.   ;;恢复系统变量值
    
49.   (setvar "cmdecho" OLDECHO)
    7 K! t: K: k& I/ u3 y5 x9 j/ D0 Q% w) U( ^
50.   ;;恢复系统变量值
    
51.   (princ)
    
52. )

复制代码