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

rc21

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


(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
% j( ?* O) d6 d4 Y1 j! M8 S2 D% E(vl-load-com)
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
2 k& J8 ~3 h  ?/ v( s& N(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
(setvar "cmdecho" 0)
(setq path
(strcat
(vl-string-right-trim
( e" Q7 g- R1 M( c "\\"
(strcase (acet-ui-pickdir
2 l! q% r$ }2 U4 A/ y: a2 w6 e) W0 T "选择目录"
(vl-string-right-trim "\\" (getvar "dwgprefix"))
"批量修改"
)
4 w3 r6 Y: A4 X  K- V )
)
) I7 s6 T3 L3 g  e, S "\\"
- P* x" o- i" I4 b# N )
)
(setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
+ i6 O( N/ z% d( E(setvar "acadlspasdoc" 0)
& [" {3 X' _8 J (setq dwgname (vl-directory-files path "*.DWG"))
! n4 @6 U" ^% B- |6 p (setq num 0)
(if (/= dwgname NIL)
4 |+ |. Z8 m% [. L4 X% G (progn
) M9 H' Y( Q* q# O7 Y- {  q (setq APP (vlax-get-acad-object));获得Acad 对象
- ]" D# L4 H. z6 C% ~- h(repeat (length dwgname)
(setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
(setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
$ g& l) u; D4 [! { 得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
; P! g0 C6 A. F4 U2 _;; …
;; …
(vla-close doc :vlax-false);关闭图形(不检查是否保存)
: k) e- J! d# k6 x' E (setq num (1+ num))
6 F  ^6 @: c+ e8 N8 z! G1 _6 s )
(vlax-release-object doc)
4 Q6 n0 I- i+ h1 J0 B- K. M, O (vlax-release-object APP)
1 \2 O3 q4 |, p* N3 o )
(prompt "\n所选目录中未有任何图形!!")
)
4 H# r8 ]; f! o- U$ u" R (setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
& _+ I0 Z, s: Z* T% e(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
5 A& ^9 q" e/ ~+ F$ h; L(princ)
)

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   , D* ?& \- ?4 p. G
2. ;;需要相应版本的ET（Express Tools）工具支持
   / |  }- D" V! g2 u* F' Z' H2 J
3. (vl-load-com)
   . I: S1 a, W7 N3 v' A* P
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   4 f/ j+ U1 Q; k7 I2 Q' G$ W* u
5. ;;主程序定义
   ' g/ P; ~8 n1 m3 m2 {
6. (setq OLDECHO (getvar "cmdecho"))
   
7. ;;保存系统变量值
   
8. (setvar "cmdecho" 0)
   
9. (setq path
   - U0 Q; Q8 j4 l( C1 [. z, E
10. (strcat
    ! `) K: b4 d1 ]1 Q3 o9 C9 ^; ]! a% `, B
11. (vl-string-right-trim
    
12. "\"
    
13. (strcase (acet-ui-pickdir
    
14. "选择目录"
    ; ?9 H9 R6 ?% v1 B+ ?+ H
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16. "批量修改"
    " e# F( Z4 `' P+ @8 E9 k
17. )
    
18. )
    
19. )
    
20. "\"
    9 H* a0 t+ H$ X: g4 z" T
21. )
    4 B9 w! N& L" Q- r
22. )
    
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24. ;;保存系统变量值
    7 G3 a" M1 Q+ m$ {
25. (setvar "acadlspasdoc" 0)
    . s9 ^  V+ x% w, b, A8 P. ~
26. (setq dwgname (vl-directory-files path "*.DWG"))
    ! r+ b# ]  a0 a0 D
27. (setq num 0)
    & r5 c  W: ]7 K
28. (if (/= dwgname NIL)
    0 {( c  w4 g  C$ Y
29. (progn
    8 K0 g( B7 U* o
30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    
31. (repeat (length dwgname)
    # S) x$ t  e9 f2 u! i0 h* D
32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    # r' E! a9 Y; @; X0 J$ z1 f+ U
33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    ' k& T( f! A& q+ \# S0 t: G" c
34. ;打开图形并获得其对象
    5 R0 u# N" s% F9 ~6 }5 S0 {: a5 ]
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    
36. ;; …
    
37. ;; …
    # O  u8 j, ~6 A! o, U' j
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    
39. (setq num (1+ num))
    
40. )
    # Z5 v: t, R1 f9 T( |$ |
41. (vlax-release-object doc)
    9 P. G% F0 a, g+ D/ q( B, R
42. (vlax-release-object APP)
    ; o2 S1 S  i  g4 o  c$ ^6 f& @
43. )
    
44. (prompt "\n所选目录中未有任何图形!!")
    
45. )
    
46. (setvar "acadlspasdoc" OLDLSP)
    
47. ;;恢复系统变量值

复制代码

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

你在使用中出现过这个对话框吗?
如果出现了,在其中选择相应目录即可.
. n8 D. x$ \/ m/ B如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21

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

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)
   
5.   ;;主程序定义
   % y$ [$ A- H5 U$ S$ r* F, y/ R
6.   (setq OLDECHO (getvar "cmdecho"))
   8 k; Q& v0 |" A: _
7.   ;;保存系统变量值
   
8.   (setvar "cmdecho" 0)
   ) D- J2 P! b  v8 D; G- z! |* I3 R
9.   (setq        path
   
10.          (strcat
    3 c1 V( Y7 Y( N) C+ j$ L
11.            (vl-string-right-trim
    ) T0 j" _2 r% U
12.              "\"
    - r6 e; F8 f9 _: \, `9 Z7 A
13.              (strcase (acet-ui-pickdir
    9 O5 E/ E7 c) Z, H2 U3 F! C
14.                         "选择目录"
    # W; b( S% p$ r& X8 h
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16.                         "批量修改"
    ; K& r. ~6 l8 e3 W" ]
17.                       )
    
18.              )
    % B# L; V8 k# l/ S2 F5 ~
19.            )
    , m  Y2 i2 x' E+ @
20.            "\"
    
21.          )
    % D7 P# C" X, i3 Y
22.   )
    ' }& x. T: d' \/ c" b
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24.   ;;保存系统变量值
    + o# u( Y! J9 v. f: {
25.   (setvar "acadlspasdoc" 0)
    
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))))
    
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    ; e% {) `5 S  `' A7 v9 ?) t- F
34.                                         ;打开图形并获
    
35.         得其对象
    4 Y' \0 p% j4 ?4 C4 R& g
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    
37.         ;; …
    
38.         ;; …
    
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    
40.         (setq num (1+ num))
    
41.       )
    
42.       (vlax-release-object doc)
    
43.       (vlax-release-object APP)
    
44.     )
    
45.     (prompt "\n所选目录中未有任何图形!!")
    5 b4 ^5 p  P2 Q
46.   )
    * ]' s  D' K  v9 H
47.   (setvar "acadlspasdoc" OLDLSP)
    
48.   ;;恢复系统变量值
    3 y0 E7 T4 v8 Z# l
49.   (setvar "cmdecho" OLDECHO)
    . i! |& Z# U4 _% `
50.   ;;恢复系统变量值
    
51.   (princ)
    + y" i3 O) E: ?, r9 w
52. )

复制代码