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

rc21

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

& O$ c6 i3 S& e& N
(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
(vl-load-com)
/ y! n! ~, c& @) \' O5 |& w (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
" S; W$ D1 [* N  f. H! x(setvar "cmdecho" 0)
(setq path
(strcat
(vl-string-right-trim
"\\"
0 q* G# v. C; j# f! n (strcase (acet-ui-pickdir
, F& [# I& V! a0 X "选择目录"
+ @3 G" v  A# I5 ?- @# I' i/ R (vl-string-right-trim "\\" (getvar "dwgprefix"))
"批量修改"
# t! O. e/ e2 A7 { )
9 g9 S3 I7 d6 Y )
)
"\\"
& Z* p  z0 S) D# t! c )
)
(setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
" l; h' |+ y/ F% i  X(setvar "acadlspasdoc" 0)
8 M3 x4 G0 r  M: j (setq dwgname (vl-directory-files path "*.DWG"))
(setq num 0)
# S# p6 L; G3 Y (if (/= dwgname NIL)
(progn
(setq APP (vlax-get-acad-object));获得Acad 对象
5 n( i$ {+ d) z4 B+ p0 y. U9 _(repeat (length dwgname)
(setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
(setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获
# ^& L  e: B& u9 |+ h- L 得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
4 {0 b& D7 w! G- |+ R;; …
;; …
(vla-close doc :vlax-false);关闭图形(不检查是否保存)
3 [8 t+ ]1 h. b! J5 x (setq num (1+ num))
7 |% C' `& i, \- L )
% q- i' x' [3 X# P (vlax-release-object doc)
6 ^8 i& J( ]+ J (vlax-release-object APP)
, `$ g; M  k* e0 \0 N )
(prompt "\n所选目录中未有任何图形!!")
)
% h# d7 t, Y. z7 \  [2 R+ L (setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
  [/ d% \' l: i' {6 d(princ)
)

woaishuijia

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

1. (arxload "acetutil.arx" NIL)
   - O+ `) ~5 w% J  s0 p
2. ;;需要相应版本的ET（Express Tools）工具支持
   7 E9 b) i; t1 a* [$ l: p: Y
3. (vl-load-com)
   9 R+ X6 X- j  g" t3 l" i
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
   
5. ;;主程序定义
   
6. (setq OLDECHO (getvar "cmdecho"))
   
7. ;;保存系统变量值
   
8. (setvar "cmdecho" 0)
   
9. (setq path
   
10. (strcat
    
11. (vl-string-right-trim
    
12. "\"
    
13. (strcase (acet-ui-pickdir
    : E* [7 Y3 N- Z3 {5 F$ R2 ~
14. "选择目录"
    ! `0 V0 p+ P5 O4 Z8 f: y7 V/ `( w3 C0 I
15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    # }. T2 U, n' I+ Q5 B0 F
16. "批量修改"
    
17. )
    ( V! @$ Z! {# w& s9 m
18. )
    . @+ ^+ \  ?9 U3 B7 l
19. )
    3 G$ M* E. W8 U% U: M/ [
20. "\"
    
21. )
    
22. )
    : P4 v9 c4 ?. ^/ n* j( Z6 [2 w) {
23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    
24. ;;保存系统变量值
    " n- d4 i, b- @" S' ?3 M
25. (setvar "acadlspasdoc" 0)
    
26. (setq dwgname (vl-directory-files path "*.DWG"))
    
27. (setq num 0)
    
28. (if (/= dwgname NIL)
    ; N" F% V$ A, g% N3 d
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))
    
34. ;打开图形并获得其对象
    ' r2 W5 X0 |$ w4 T7 O
35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    4 x$ [! |# N# P* g
36. ;; …
    . X5 |. u& Q6 b* [7 y1 ~
37. ;; …
    
38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    ) h/ Q2 P* K& H& ?8 P3 O3 p8 q! q
39. (setq num (1+ num))
    / X, M( l8 \6 ]+ u! U
40. )
    5 D5 }% g) Y8 d) Q6 K
41. (vlax-release-object doc)
    % ?/ O0 a' c( i% L
42. (vlax-release-object APP)
    
43. )
    0 K  V' D( ~9 h3 P$ x0 K
44. (prompt "\n所选目录中未有任何图形!!")
    
45. )
    & g8 Q& t" t" Z- a
46. (setvar "acadlspasdoc" OLDLSP)
    0 H% e+ r3 z1 Y
47. ;;恢复系统变量值

复制代码

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

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

rc21

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

1. (arxload "acetutil.arx" NIL)
   
2. ;;需要相应版本的ET（Express Tools）工具支持
   3 y1 \7 y! E. @( Y6 J
3. (vl-load-com)
   " J7 A- h( m! l# H0 ]
4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)
   
5.   ;;主程序定义
   
6.   (setq OLDECHO (getvar "cmdecho"))
   
7.   ;;保存系统变量值
   
8.   (setvar "cmdecho" 0)
   
9.   (setq        path
   
10.          (strcat
    : y& L8 w/ x: i, x! \' q% ?3 K5 z
11.            (vl-string-right-trim
    ( Z. @, e$ h' z9 n
12.              "\"
    
13.              (strcase (acet-ui-pickdir
    
14.                         "选择目录"
    
15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    
16.                         "批量修改"
    3 ~/ E! b7 y( V0 t# ]! g" Z
17.                       )
    
18.              )
    
19.            )
    1 i9 C) t* ^, G* _3 U$ b
20.            "\"
    
21.          )
    
22.   )
    % o! Z) k/ b0 @: S0 o
23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    # P) k; ]5 {3 [, E$ S0 b
24.   ;;保存系统变量值
    0 s( x5 b/ m7 K% _  u  I
25.   (setvar "acadlspasdoc" 0)
    
26.   (setq dwgname (vl-directory-files path "*.DWG"))
    
27.   (setq num 0)
    5 ?+ Q6 _) `! i; n; c
28.   (if (/= dwgname NIL)
    ; c/ ]8 ~8 I: D$ A# \
29.     (progn
    
30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    
31.       (repeat (length dwgname)
    7 m. s) Z* N) T
32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    
33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
      p3 J9 W! U  \2 y! X9 Q
34.                                         ;打开图形并获
    
35.         得其对象
    ! T4 Z3 i. @5 }1 l) Y: Z
36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    
37.         ;; …
    ! U5 u7 u& r( y# f  J: M" c' L% ?
38.         ;; …
    + U* m% t' T' `/ G2 B
39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    . p! _+ O  v' ^# w8 O
40.         (setq num (1+ num))
    
41.       )
    4 M' ^$ J( }# X8 c3 v2 r5 j& c
42.       (vlax-release-object doc)
    
43.       (vlax-release-object APP)
    / C9 y8 e2 M# g8 A* R
44.     )
    6 K9 O5 x8 v5 |" n6 e
45.     (prompt "\n所选目录中未有任何图形!!")
    
46.   )
    
47.   (setvar "acadlspasdoc" OLDLSP)
    - t6 R0 }0 J* M1 p+ o6 p
48.   ;;恢复系统变量值
    0 J: \" T+ r: o9 }( ^
49.   (setvar "cmdecho" OLDECHO)
    2 r. |9 N9 w' A
50.   ;;恢复系统变量值
    - X" Q) \. L; u3 i
51.   (princ)
      r2 O# E" |+ y( Z
52. )

复制代码