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

rc21 · 发表于 2013-9-27 15:17:47

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

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

(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持
(vl-load-com)
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
);;主程序定义
(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
(setvar "cmdecho" 0)
(setq path
(strcat
(vl-string-right-trim
"\\"
(strcase (acet-ui-pickdir
"选择目录"
(vl-string-right-trim "\\" (getvar "dwgprefix"))
"批量修改"
)
)
)
"\\"
)
)
(setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
(setvar "acadlspasdoc" 0)
(setq dwgname (vl-directory-files path "*.DWG"))
(setq num 0)
(if (/= dwgname NIL)
(progn
(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));打开图形并获
得其对象
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
;; …
;; …
(vla-close doc :vlax-false);关闭图形(不检查是否保存)
(setq num (1+ num))
)
(vlax-release-object doc)
(vlax-release-object APP)
)
(prompt "\n所选目录中未有任何图形!!")
)
(setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
(princ)
)

woaishuijia · 发表于 2013-9-28 06:54:58

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

(arxload "acetutil.arx" NIL)
5 \, p9 ?1 `: e' o8 z+ c8 N
;;需要相应版本的ET（Express Tools）工具支持
7 B9 c0 j$ O( {8 ]% s7 b6 ?
(vl-load-com)* f, ~3 Y: y' M( T. v/ ]9 Z6 x$ L2 f, J
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
;;主程序定义- |6 ] `2 G2 R: U8 y
(setq OLDECHO (getvar "cmdecho"))+ X0 | J- |- a0 l# z8 m
;;保存系统变量值
1 J+ z8 M+ `: }: l6 \+ N
(setvar "cmdecho" 0)
7 l, c1 j0 [7 ^% R6 u) L
(setq path
' V" Y% R I" ?4 Z b
(strcat+ D- y" t( A/ S4 O6 b, l% E
(vl-string-right-trim) d/ H+ [5 n4 w
"\"
W8 [9 L( J+ J+ ]+ D
(strcase (acet-ui-pickdir; i7 l+ w; J' m/ a7 P: p6 j4 L7 a) A
"选择目录"
; P, J5 O" B6 A+ S* L0 j( O
(vl-string-right-trim "\" (getvar "dwgprefix"))
# t; t3 q7 W7 S3 m( N- r
"批量修改"( b" A) \4 l6 y9 M7 U
)
' g. S" D' ~8 x1 V. J
)% h, a5 \0 u9 v
)7 Z$ x Z5 t8 X5 o
"\"
( \' @5 m! B V$ W
)
( h/ p& \( ?4 g4 a
)
( ~5 ]7 ?& k, L1 A- Y" L
(setq OLDLSP (getvar "ACADLSPASDOC")) ]% }, u/ Z4 C
;;保存系统变量值
0 f0 e. C3 i" x6 ?9 ~
(setvar "acadlspasdoc" 0)
! W; q- `' h. Z, {2 a5 y
(setq dwgname (vl-directory-files path "*.DWG"))
9 y- Y. w( C3 i" c$ g: w* u
(setq num 0)" x+ u3 g* I9 Q, j) l
(if (/= dwgname NIL), W, a7 x5 `& N* ]/ v
(progn. Y8 M& P( u& V7 h9 v
(setq APP (vlax-get-acad-object)) ;获得Acad 对象
- N; t" @5 h" j0 M2 _
(repeat (length dwgname)" C& C$ h. S- x9 X( D. o
(setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
s' y8 l$ S7 E* l9 h0 B) ]
(setq doc (vla-open (vla-get-documents APP) DWGNAME2))( q2 ?& |# p* h9 z+ v7 V% [% C
;打开图形并获得其对象& F, k. ^7 [( H% E2 B) k/ L: c6 _$ l H
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。+ C# T8 p$ W Y3 n; ~4 H; a
;; …
0 a5 E0 Q. @- l v' I9 h9 E
;; …1 f& j7 D3 h) H( S4 S" d
(vla-close doc :vlax-false) ;关闭图形(不检查是否保存)) O: P" E2 R/ G, O- v2 a, o
(setq num (1+ num))5 _! D+ q! ]$ \& a
)
: ^# v5 t: P- o; S, z0 a" E
(vlax-release-object doc)
6 Z3 i3 v( l& K6 C. w
(vlax-release-object APP)
& ]& h. f/ l$ L% x" m H- _
)4 _4 B1 C2 S* x% o S8 x
(prompt "\n所选目录中未有任何图形!!")
2 k4 K& c2 l: L; K
)0 O" l& [1 g% D4 ?
(setvar "acadlspasdoc" OLDLSP)
! w+ X& a/ \! t& J* T/ N
;;恢复系统变量值

复制代码

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

你在使用中出现过这个对话框吗?

如果出现了,在其中选择相应目录即可.
如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.

rc21 · 发表于 2013-9-28 11:30:55

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

(arxload "acetutil.arx" NIL)& f# x4 L3 u. Z3 H
;;需要相应版本的ET（Express Tools）工具支持. e: O! ^9 d5 [/ {
(vl-load-com)
; M/ W) A0 s, m' w
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)' M) \( Y' c$ _8 s) {1 G
;;主程序定义
& Q9 w) Z4 u0 H' o
(setq OLDECHO (getvar "cmdecho"))% L( @4 w" D* i. X8 J
;;保存系统变量值
, d# ]( _% _3 }& p, X. _8 v! |. B
(setvar "cmdecho" 0)5 B! d/ D7 {9 X7 a$ I
(setq path
( s" i2 ~# x8 r
(strcat
9 T! q8 p& ]" t+ V9 W) @0 l) a( ?
(vl-string-right-trim
"\"
! u1 d9 q3 F* [( n" S5 g5 N9 @
(strcase (acet-ui-pickdir$ E! h. M3 Z, Z% H' A: z. e
"选择目录"5 d' e& C% e( @6 {; p: W
(vl-string-right-trim "\" (getvar "dwgprefix"))
( f8 ~! V0 P: D. q
"批量修改"9 |: E: s; j' n1 S4 r0 `
)( ]9 C1 T$ n" \7 D+ Y( Y* R# s2 L
)4 G+ Q& U7 [ l+ a# i" Y+ J
)2 e; B( l4 e8 J9 G* |
"\"
2 b4 p& D3 J+ r# t. E+ N0 h5 b( Z
)
$ N- S: m9 E+ w' c0 ?
)2 }/ p# M' S0 u
(setq OLDLSP (getvar "ACADLSPASDOC"))
: y; Z* Q5 s2 y; B2 `' T: U
;;保存系统变量值
; R& c' b7 W# z B
(setvar "acadlspasdoc" 0)
+ Y2 e8 E9 u- h7 M0 B5 Y
(setq dwgname (vl-directory-files path "*.DWG"))% c. I) V7 @" P' B: {2 v7 x
(setq num 0)
7 `2 }# L/ T: Y2 ]# \# E
(if (/= dwgname NIL)
8 U0 E/ q1 r, `) ]
(progn
$ B8 O/ D' j& y6 c; @6 [8 L7 H$ i* U
(setq APP (vlax-get-acad-object)) ;获得Acad 对象
/ y+ s/ {3 @8 _) |- Y3 q
(repeat (length dwgname)* |6 B) c, J }' t, ^* U
(setq DWGNAME2 (strcase (strcat path (nth num dwgname))))3 n x9 t5 O0 Z m: _7 C7 H
(setq doc (vla-open (vla-get-documents APP) DWGNAME2))- w' }1 K% {" p4 j `9 A
;打开图形并获
* D# C0 l' N9 b3 @ U0 g: C( Z5 W
得其对象
6 I q4 n( q. V
;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。1 r( p+ q, p4 j' a, L
;; …
. V4 ?, j* z- r1 M; q
;; …
% o4 l, g& e6 l3 L0 H
(vla-close doc :vlax-false) ;关闭图形(不检查是否保存)( n6 U" y' p1 [+ c, K" S* ]- i
(setq num (1+ num))
; z ^# r. o; V. m; c
)
) k/ l" I1 ^' n5 Z
(vlax-release-object doc)
! V# r4 N2 i' p4 w- ^1 U
(vlax-release-object APP)) o; ^3 f' \1 V0 y
)( T8 g6 ~1 |& K M4 {- T
(prompt "\n所选目录中未有任何图形!!")
4 W' G& R; s% `4 y1 z( U/ m3 l
)' }+ |" c/ C4 `9 m
(setvar "acadlspasdoc" OLDLSP)
0 N! j2 }; ] i# _7 [& {$ C
;;恢复系统变量值
y2 N, U0 g4 d* w" z% q
(setvar "cmdecho" OLDECHO)
. Z* y- l% }1 N/ V- o) B
;;恢复系统变量值$ m$ M& ~ e/ x9 U' _/ o% z( Q8 y
(princ)" u% x6 p% L, A+ \0 z4 R' T
)

复制代码

		自动登录	找回密码
密码			注册

通知

[求助] 关于LISP批量处理查找文件的问题

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

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

浏览过的版块