QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

查看: 3167|回复: 2
收起左侧

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

[复制链接]
发表于 2013-9-27 15:17:47 | 显示全部楼层 |阅读模式 来自: 中国湖北武汉

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

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

x
下面是在网上找的一段图纸批量处理程序,经使用发现只能在所选择的根目录查找dwg文件,对于子目录的dwg文件却不能查找到,因本人不懂LISP也就无法修改,请大师们帮帮忙,给改改这个段程序,使之不论是选择的根目录还是此根目录下的子目录也能查找到所有dwg文件,在此先谢过!!
- \) p- a4 {& Z& z' O0 T0 h. w, b* T3 U0 N# r

: M% ~, Y% H8 L
(arxload "acetutil.arx" NIL) ;;需要相应版本的ET(Express Tools)工具支持) s6 D/ F4 B+ ]  n( c
(vl-load-com)/ }4 V2 f% Y) b8 j3 @6 ?5 W
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent
/ U) h& l' @) t" a3 E2 Y );;主程序定义
9 ^0 E! u9 i5 L6 R* I! |(setq OLDECHO (getvar "cmdecho"));;保存系统变量值
& ^$ S" C4 c2 N$ N( _(setvar "cmdecho" 0)* S& F) r6 K& a* ~& L" l: E" q
(setq path
$ A7 X9 d# O- r" B: q- V (strcat5 F6 |$ X5 ~" g" r5 i/ _9 N! H
(vl-string-right-trim8 s% d, n& e, {/ I1 \: g
"\\"$ g7 U# [  ?' F$ k
(strcase (acet-ui-pickdir2 N9 x' Y& g, ^7 n" B  \+ f
"选择目录"
& m; d, s: S$ _: Z- c0 d+ y& u (vl-string-right-trim "\\" (getvar "dwgprefix"))
" \/ `& e( L  ?3 A2 V" n6 D "批量修改"
+ Q5 l: }( \* a2 j, ~. g ): e; _. \  b1 x% T* a; @
)# |- j5 ?0 U' m* T1 h8 N# C
)7 t' `* h4 e6 H4 h
"\\"+ e" G2 j; }# t) U4 _6 I
)0 U* c* |2 k# A( \. R
). t! V# K0 ?: x6 a* E) R
(setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
0 Y: _4 p- u' c0 A/ d9 Z1 ~(setvar "acadlspasdoc" 0)- A+ r% I4 J+ y1 T
(setq dwgname (vl-directory-files path "*.DWG"))
# G% o3 `2 G+ F1 F9 l (setq num 0)
# N$ ?5 y8 T4 J. Z. j (if (/= dwgname NIL)& I6 T3 @1 U. [) |( X1 l8 J
(progn
# f* M; b3 }  I# Q6 D5 s! O (setq APP (vlax-get-acad-object));获得Acad 对象7 x& _3 w! x3 B# ?$ P
(repeat (length dwgname)2 w, [: b" u) ~0 t4 l
(setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
/ t8 J% u9 c' b4 l# _& n( Q0 S (setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获( D3 I: w3 }) Y! e: O/ G, _
得其对象' V( ?% `4 @" N( l; W+ C
;;以下用省略号代表具体处理程序,用户可在此处添加自己所需的处理的代码。
6 A# A& d$ y9 J6 C;; …4 C9 M) }. }  p2 A! x0 o( w4 R, w
;; …$ F4 L( S* J& g- [& k" l- M
(vla-close doc :vlax-false);关闭图形(不检查是否保存)
! O: i# n$ Q- L- v  g& e (setq num (1+ num)). Q. y* Z; c/ ^, R+ Q
)
' W( E' V" C! s- \ (vlax-release-object doc)6 G( k. p* q7 n9 Y) `. O6 t
(vlax-release-object APP)
) v5 P0 L# g: ~0 x+ i% y ), u0 d1 S& c2 O, ~5 }9 L- G
(prompt "\n所选目录中未有任何图形!!")
3 B- y8 ]; P0 l' n- u% D8 e )2 b( |' N% u0 h
(setvar "acadlspasdoc" OLDLSP);;恢复系统变量值2 U  [' e1 w2 e1 [3 c! g2 J+ M
(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
) w, }* ]) G: [6 c* V(princ)
5 \! ?8 ?8 H3 ] )
发表于 2013-9-28 06:54:58 | 显示全部楼层 来自: 中国吉林长春

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

代码本身只有一点小问题,应该是你上传时操作错误造成的,应与代码无关.重新帖一次,对照一下
  1. (arxload "acetutil.arx" NIL)
    . v5 m% L/ Q' I" E4 J. a
  2. ;;需要相应版本的ET(Express Tools)工具支持
    ' F% c) y2 d) Z; x# j; A* z4 t
  3. (vl-load-com)
    4 i7 T2 ]0 w' o( u6 h' C
  4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent)
    & B) v) R# I+ F2 l7 n
  5. ;;主程序定义( c6 m1 {- V$ B+ u: w
  6. (setq OLDECHO (getvar "cmdecho"))
    ) A' R0 B8 Z8 W2 O, E* r
  7. ;;保存系统变量值" Z7 s' B  m; a  o3 ]! J( \/ d
  8. (setvar "cmdecho" 0)" v/ y! M  |# b, A6 g0 p
  9. (setq path. F/ B3 y7 y; X( q2 i9 P' ?5 \
  10. (strcat
    - A2 j% A! H0 y/ p" P
  11. (vl-string-right-trim
    ; I: B+ @1 z; ]  k1 N% j5 C
  12. "\"7 r* {# W  e2 A+ x) _
  13. (strcase (acet-ui-pickdir2 K% Y+ W$ S3 n: a  u: h4 ?. d
  14. "选择目录"
    & ?, q- Y6 |7 S$ W
  15. (vl-string-right-trim "\" (getvar "dwgprefix"))
    2 w; H0 ^8 h3 f5 j( N* @1 V' ?. D
  16. "批量修改"/ Z4 Z- P8 o0 |1 C" J& A# L
  17. )
    # K7 Z7 N( d: n4 ?2 L/ j6 k
  18. )# h- s0 U# M$ B: K; P- D0 ]% x/ n
  19. )
      p4 `9 D. O: Q9 t
  20. "\"* ?6 u% L6 L) m
  21. )
    - N; G9 J+ A! v6 S9 n( r; ]' m
  22. )
    9 {8 [- ?- h- X" C5 }3 Y
  23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    / D! R# b. Z% \  j6 v
  24. ;;保存系统变量值
    - |7 }# ~' o3 z# \+ G4 t" x
  25. (setvar "acadlspasdoc" 0)
    4 G: \2 b0 N7 ^! |
  26. (setq dwgname (vl-directory-files path "*.DWG"))1 T- O/ [+ f0 K# d. R; W5 `; t
  27. (setq num 0)
    # N8 L0 v$ ^0 Z, b' M9 }% h: S
  28. (if (/= dwgname NIL)0 d1 U) y( j2 F5 L' J
  29. (progn
    ) f6 o0 b0 R& @' ?' J, d
  30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象
    0 W$ d7 x( _% h3 c
  31. (repeat (length dwgname)/ D8 c( T. G3 o" [9 T; l. A) X
  32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    : D  D- {9 r  U9 I' n) {( I2 e; U
  33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    5 A$ P- }, K, V
  34. ;打开图形并获得其对象! K0 i2 d& ^" ?* D
  35. ;;以下用省略号代表具体处理程序,用户可在此处添加自己所需的处理的代码。
    3 Q) N5 w  x' o& W
  36. ;; …
    ( O- u: S& S3 x0 K5 X2 O7 Q6 g5 c
  37. ;; …
    & K) a$ k/ ]& N
  38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)
    0 L# u; W+ l$ k5 m2 r
  39. (setq num (1+ num))7 J. ?- O! [2 l& z9 H8 n; O3 ~% B
  40. )/ ^* ^6 `  o3 x8 [9 z8 p/ ~
  41. (vlax-release-object doc)) p; i* v/ W2 V3 O% {' _8 u0 ^
  42. (vlax-release-object APP)$ g. b8 o; }% E5 ]8 |, K0 g0 D
  43. )* N. y0 B8 D( E. l, i! r
  44. (prompt "\n所选目录中未有任何图形!!")
    * n4 L5 ]/ E7 n! b
  45. )! C1 G( f# Z. h, _, q0 i: \+ t
  46. (setvar "acadlspasdoc" OLDLSP)
    + c6 V. [1 Y$ {& E1 \
  47. ;;恢复系统变量值
复制代码
PS:下次发布包含代码的帖子,请使用格式符,否则代码中会有乱码,别人无法复制,也就没人理你了
# [- `7 S' E& p" X
+ t  y- U; K3 F% S# s) [0 W你在使用中出现过这个对话框吗? Untitled-1.gif ( t, n1 C" j- j
如果出现了,在其中选择相应目录即可.
8 X  ^" U* x3 n, E+ q如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.
 楼主| 发表于 2013-9-28 11:30:55 | 显示全部楼层 来自: 中国湖北武汉
我的CAD已经安装ET工具且运行时也出现版主说的对话,也选择了目录,只是此程序只对所选择的目录下存在的dwg文件进行查找,而对于所选择目录下的子目录或子目录下的子目录内的dwg文件不进行查找,我觉得此程序存着这点不足,往往对下级目录及下下级目录遍寻查找dwg文件却又很有必要,若有十级的子目录再一级一级去选目录有些显麻烦了,再者此程序不能记忆刚选过的目录,操作略显麻烦,所以请版主及各位lisp大师们帮帮忙修改一下程序,使之可以遍寻选择目录及其子目录下的所有dwg文件,谢谢!9 }) T0 C) p& Z4 e3 V4 T
附件中上传原程序。
  1. (arxload "acetutil.arx" NIL)
    8 D- k/ f- Z7 L% M: x' S" y
  2. ;;需要相应版本的ET(Express Tools)工具支持
    3 ?* a8 Y# q1 _1 C
  3. (vl-load-com)4 `" ]/ x9 u0 p8 X
  4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)" Y' U  U+ z) i9 A4 l
  5.   ;;主程序定义
    ) d+ z( [$ o8 [; B, {" g
  6.   (setq OLDECHO (getvar "cmdecho"))" w1 _1 u4 J& N5 w) s% s% F
  7.   ;;保存系统变量值
    8 C9 q) s  _! t" d1 }
  8.   (setvar "cmdecho" 0)
    " w+ M2 s  x" Q, Y5 D; c
  9.   (setq        path
    , k# _1 i  Z- d( m6 n, _, X
  10.          (strcat
    * J; U1 g/ ]( P  _8 H4 c: C
  11.            (vl-string-right-trim
    2 o# q! i8 L9 p- h# N9 q& i
  12.              "\"
    ( W# N1 r$ A- A
  13.              (strcase (acet-ui-pickdir; P; A2 _% }1 d
  14.                         "选择目录"3 U! @: C) O" ?5 s9 j- @* @$ j* }( D/ E
  15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))2 {6 r+ u% d3 l8 ?2 |
  16.                         "批量修改"6 M6 z' k0 \0 H- a4 W9 s' X) j, s
  17.                       )$ ]9 d" ~+ X  ]8 N6 T# `
  18.              )
    / M* e1 A7 K3 X: l2 d
  19.            )
    / k  u+ e9 C' G6 y# m! J& v# H
  20.            "\"1 a; ^1 _; [8 d% q% [( f: a* j
  21.          )
    1 a) N! M: Q3 @
  22.   )
    6 b( j& x+ r1 y% k6 L6 ~, @
  23.   (setq OLDLSP (getvar "ACADLSPASDOC"))
    ( T5 \: L. |( Q# F3 ?1 I; e
  24.   ;;保存系统变量值
    & r. s) X& w6 n5 y
  25.   (setvar "acadlspasdoc" 0), u# q* |4 V3 M7 n% n9 J
  26.   (setq dwgname (vl-directory-files path "*.DWG"))0 L; e+ F9 |1 l" ^
  27.   (setq num 0)& t8 ]+ }- G) P3 S+ R
  28.   (if (/= dwgname NIL)
    0 w9 |2 U3 B. z, ?7 p. ]* i
  29.     (progn" v$ f( R9 x7 I( N
  30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象$ g! F5 L5 S9 C2 b
  31.       (repeat (length dwgname)* G+ ^" q* f7 d
  32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    1 {6 V/ c: e5 l. V+ X( r6 T$ r' M
  33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    2 P! B  e5 O: A, f
  34.                                         ;打开图形并获
    1 [4 m+ t  F7 K" K# R) s8 [
  35.         得其对象: O, x$ \8 H/ P) Y6 S
  36.         ;;以下用省略号代表具体处理程序,用户可在此处添加自己所需的处理的代码。
    / ~( E+ ?# |1 P: ~8 T9 y
  37.         ;; …4 h7 X2 s/ v$ v& U) c, ?; y2 \
  38.         ;; …
    1 V4 j8 d6 j' J% M, S
  39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    6 L$ J( o$ w" ?( ?9 Z! C1 d9 V: a
  40.         (setq num (1+ num))
    & u& Q$ l/ {' L) L/ S* k
  41.       )1 e) s: A( w4 I' M1 V0 C" l" z, J
  42.       (vlax-release-object doc)
    : _& S  U, M+ x9 o% E1 c
  43.       (vlax-release-object APP)
    7 R( u/ ~' |1 P" f5 g9 I+ A
  44.     )! Y- t0 [: ~! }
  45.     (prompt "\n所选目录中未有任何图形!!")# B: n9 W' S- d! ]1 b2 T
  46.   )
    ; p9 `: t0 a$ ^5 [6 I
  47.   (setvar "acadlspasdoc" OLDLSP)( Q  j5 }2 f8 Z
  48.   ;;恢复系统变量值
    ) g/ O6 }8 _& J6 }* H6 w
  49.   (setvar "cmdecho" OLDECHO)
    " M7 Y: M- x* o2 ^4 i6 e
  50.   ;;恢复系统变量值6 F( i4 |3 O: m
  51.   (princ)
    8 H; L8 n; x6 c
  52. )
复制代码

GTEXT.rar

844 Bytes, 下载次数: 16

发表回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则


Licensed Copyright © 2016-2020 http://www.3dportal.cn/ All Rights Reserved 京 ICP备13008828号

小黑屋|手机版|Archiver|三维网 ( 京ICP备2023026364号-1 )

快速回复 返回顶部 返回列表