设为首页 |收藏本站 |帮助 |加入VIP |积分充值

QQ登录

只需一步，快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步，快速开始

返回
发新贴
展开

通知     

全站
5天前
查看: 3139|回复: 2
收起左侧

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

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

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

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

x
下面是在网上找的一段图纸批量处理程序，经使用发现只能在所选择的根目录查找dwg文件，对于子目录的dwg文件却不能查找到，因本人不懂LISP也就无法修改，请大师们帮帮忙，给改改这个段程序，使之不论是选择的根目录还是此根目录下的子目录也能查找到所有dwg文件，在此先谢过！！
5 Q# s4 p$ X/ U6 Y& l- k+ @9 U  e" R9 W( ?, `0 k1 s( f( u1 Y* f! V
  H) A( j, {1 r' x, T9 V
(arxload "acetutil.arx" NIL) ;;需要相应版本的ET（Express Tools）工具支持, P" s, N: U. y. G# O- p- U
(vl-load-com)" A' z! u  M5 k2 |& u! O
(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent7 W" H, T% F4 s4 _
);;主程序定义* c' T- R! [$ l/ n" S; x7 ]$ s$ U
(setq OLDECHO (getvar "cmdecho"));;保存系统变量值7 f: @/ q) w$ S7 z( F$ p& X
(setvar "cmdecho" 0)* S8 c* f1 e# D" S  b. K1 q& L
(setq path
# ]- e+ R' Y, ?! s: @5 r (strcat: F* }! s9 S' Y3 A: [/ w9 H
(vl-string-right-trim
$ p/ b+ c. ~3 z "\\"; n/ T5 I& Q: Y8 u
(strcase (acet-ui-pickdir1 x5 o1 V; u/ A0 L
"选择目录"4 i4 j: a1 Y9 H( N
(vl-string-right-trim "\\" (getvar "dwgprefix"))
9 L8 s4 L  l; c( l2 w' F6 E0 Z "批量修改"
) h) q# t2 x( o )) X  O% w. M6 P
)1 |) F; t; P( h; a! t8 y* E1 y
)% C! L/ s9 z2 W* z; X& O
"\\") _% J0 O  R5 t- n  I5 @' _$ P) n! x3 A
)8 n5 k: E" E, B( d% U4 h+ p( i; g! `
)- ]  N/ s& y4 v3 U/ y5 G
(setq OLDLSP (getvar "ACADLSPASDOC"));;保存系统变量值
! @% ?) g$ f$ d' r* _/ k(setvar "acadlspasdoc" 0)* a( Q* ~* x6 ~' m. R% ~6 o
(setq dwgname (vl-directory-files path "*.DWG"))
5 @( M* j/ K4 i3 a2 M (setq num 0)
* G0 C  z, U! \# @  I. Z' c (if (/= dwgname NIL)
; z3 {; ]$ x7 p; Y% W (progn0 Z8 e5 |5 K9 ^" L% L+ D: U+ D
(setq APP (vlax-get-acad-object));获得Acad 对象
9 K6 I. F* k7 {7 o( ~0 F(repeat (length dwgname)
9 S8 g2 `3 i2 B' q/ C3 P (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))/ K; `! |; s, @
(setq doc (vla-open (vla-get-documents APP) DWGNAME2));打开图形并获6 |* B/ k' l2 i$ x! X
得其对象
" W# D8 k: s2 R# o; `2 w" E;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。  J" T9 D5 i" R4 y/ h0 u1 K/ m' n
;; …( T( H/ j; }  b4 T* p; v
;; …0 w8 d4 U4 j; M
(vla-close doc :vlax-false);关闭图形(不检查是否保存)
( ^' C4 E4 E9 B' M (setq num (1+ num))4 n$ y' m% B2 R2 D7 P/ b
)
& a# u& T- c$ r& x' n (vlax-release-object doc): W4 |! S% ~+ C0 N
(vlax-release-object APP)
3 f! n- z  ?: X6 W6 E  M/ ^7 V )5 R$ U, E% E1 \3 r6 k, z, Z
(prompt "\n所选目录中未有任何图形!!")5 Z. D6 _# n# N; {, m7 P7 ~) U
)
" B1 V; ]( ]9 t1 z% o (setvar "acadlspasdoc" OLDLSP);;恢复系统变量值
& g$ K  h0 Z! P. _* ~+ F( F1 O" c(setvar "cmdecho" OLDECHO) ;;恢复系统变量值
: I0 c6 K! X4 z% `: K* c( _" u+ r- }8 p(princ)/ u( j, e* H. H% u. v+ U
)
回复

举报

woaishuijia
发表于 2013-9-28 06:54:58 | 显示全部楼层 来自： 中国吉林长春

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

代码本身只有一点小问题,应该是你上传时操作错误造成的,应与代码无关.重新帖一次,对照一下
  1. (arxload "acetutil.arx" NIL)1 t; ^. f1 h4 m) z" w, S
  2. ;;需要相应版本的ET（Express Tools）工具支持. q* p0 k" {, B9 r6 Y, g$ E
  3. (vl-load-com), w  D/ d- J# X& r; L
  4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent); M( P" M; ~& M9 i% E8 d4 R5 F
  5. ;;主程序定义2 ?* M3 F! }8 u
  6. (setq OLDECHO (getvar "cmdecho"))
    , Z" L  X- X0 q* B+ t6 }
  7. ;;保存系统变量值
    $ B% ~. w% n, ]7 u- Q
  8. (setvar "cmdecho" 0)7 _1 i6 \/ }" I) g3 B; f* s
  9. (setq path
      P3 v2 h9 z+ q* U
  10. (strcat5 ]% R3 R5 \) y& z5 f; n" V0 W
  11. (vl-string-right-trim' U7 d1 `7 D8 o
  12. "\"
    + }) @$ n9 }5 M; Z2 B  g
  13. (strcase (acet-ui-pickdir
    7 l& g; j2 O, `0 v2 P2 v
  14. "选择目录"
    2 w7 F5 M1 W6 `. p; j
  15. (vl-string-right-trim "\" (getvar "dwgprefix"))! A7 f! L7 [- k# _" e  y& {
  16. "批量修改"
    # A- D. K; p& r+ f
  17. )$ P2 ^' R. k: Z! V9 E; a
  18. )
    - o' X; ^' i" q1 J% K( m' o
  19. )8 N/ C1 I: _3 E7 v9 H7 |
  20. "\"
    $ }0 L  \: E5 ^9 J
  21. )
    0 d* v; g" C% w0 ~+ n
  22. ); n0 V/ o9 u( [4 I" C
  23. (setq OLDLSP (getvar "ACADLSPASDOC"))
    + W" l8 i& _- x8 @
  24. ;;保存系统变量值+ I6 M; r# [7 b! \4 J
  25. (setvar "acadlspasdoc" 0)3 O; `, d* C$ f/ q1 y1 ?
  26. (setq dwgname (vl-directory-files path "*.DWG"))4 `/ P4 F* i2 v1 m% ]- r& }6 M
  27. (setq num 0)/ V2 I0 \  Q6 i' U) K
  28. (if (/= dwgname NIL)# D) w& W' O" G5 ~; \" U0 R
  29. (progn0 c0 t& ~9 w4 ?  p) i
  30. (setq APP (vlax-get-acad-object)) ;获得Acad 对象" Q1 t% X1 g6 p* }2 H' q& d1 T
  31. (repeat (length dwgname)" Y: b3 y: D0 @# v
  32. (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    / k/ o! k1 p" @% v6 t8 ^1 B
  33. (setq doc (vla-open (vla-get-documents APP) DWGNAME2))
    1 V, f6 [: H3 w
  34. ;打开图形并获得其对象
    6 W0 B6 ]1 A6 B9 r' `) I
  35. ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
    ( t0 H9 n. X5 r9 t- t# E0 Y' |
  36. ;; …
    ' m, e0 h8 a# b$ x, s
  37. ;; …) d, n: x5 ^2 l" n# w- `: g
  38. (vla-close doc :vlax-false) ;关闭图形(不检查是否保存)+ j% X3 u2 ^6 p1 R
  39. (setq num (1+ num))! M- ]# k" M" d' n, n
  40. )
    5 o' Q$ d3 t; x8 A; x9 V3 T3 K
  41. (vlax-release-object doc)8 I  j9 Q+ @* R/ F
  42. (vlax-release-object APP)
    ; J" k3 ?) ?3 |# B, ]0 h9 L  ^
  43. )
    + ]$ [& d  V6 A6 @$ N
  44. (prompt "\n所选目录中未有任何图形!!")
    6 @  G: i1 x. n# Q9 Z+ t
  45. )( Y/ L* k2 L3 q# v
  46. (setvar "acadlspasdoc" OLDLSP)
    & t$ ]* I9 l) b/ L! F8 A( b
  47. ;;恢复系统变量值
复制代码
PS:下次发布包含代码的帖子,请使用格式符,否则代码中会有乱码,别人无法复制,也就没人理你了6 p+ A/ p6 h1 n, r+ b' ^
5 h% {; s+ x7 t7 W: B6 f) r
你在使用中出现过这个对话框吗? Untitled-1.gif
1 m, ^3 }# \9 P" u2 b8 v  f- X4 H0 U如果出现了,在其中选择相应目录即可.
6 v* g3 e5 x: B" o# f% {4 z如果没有出现,则说明你的CAD没有安装ET工具,本代码需要它的支持.
回复 支持 反对

举报

rc21
 楼主| 发表于 2013-9-28 11:30:55 | 显示全部楼层 来自： 中国湖北武汉
我的CAD已经安装ET工具且运行时也出现版主说的对话，也选择了目录，只是此程序只对所选择的目录下存在的dwg文件进行查找，而对于所选择目录下的子目录或子目录下的子目录内的dwg文件不进行查找，我觉得此程序存着这点不足，往往对下级目录及下下级目录遍寻查找dwg文件却又很有必要，若有十级的子目录再一级一级去选目录有些显麻烦了，再者此程序不能记忆刚选过的目录，操作略显麻烦，所以请版主及各位lisp大师们帮帮忙修改一下程序，使之可以遍寻选择目录及其子目录下的所有dwg文件，谢谢！
/ }# ]$ F9 ?/ S+ v: e附件中上传原程序。
  1. (arxload "acetutil.arx" NIL)
    $ x" \! L; l! ~3 o; {9 P4 p- \
  2. ;;需要相应版本的ET（Express Tools）工具支持' p: j( r, i# G
  3. (vl-load-com)3 A( ]9 k' \3 @: Z' b  f
  4. (defun c:GText (/ OLDECHO APP DWGNAME2 path num        dwgname        OLDLSP doc ent)- q3 Y- L# {/ ?* a# W' m" n7 k
  5.   ;;主程序定义
    0 S9 j8 W0 X$ w9 Y% p2 ?. E
  6.   (setq OLDECHO (getvar "cmdecho"))# ?; z9 t2 K7 I' A
  7.   ;;保存系统变量值2 u, u" N) e5 y* J8 v" e& v
  8.   (setvar "cmdecho" 0)( j! k: H' Q, g+ D
  9.   (setq        path
    . n, H  s" R' B; g0 V
  10.          (strcat
    $ f6 r0 u0 x, Y# v% U! z
  11.            (vl-string-right-trim
      Q. y3 Y" ?4 `' O. Z: R. @
  12.              "\"
    ( x& M1 J1 P- P" b- F
  13.              (strcase (acet-ui-pickdir$ A; L. t7 p( Y  M4 [7 l) t
  14.                         "选择目录". P% l+ u( H0 p0 n5 ^
  15.                         (vl-string-right-trim "\" (getvar "dwgprefix"))
    ( g# ~  S7 X/ n
  16.                         "批量修改"
    ' T. u  }5 u( v
  17.                       )! Y* I5 j  e3 ~
  18.              )2 u4 F/ ^5 m6 n3 F7 X2 j
  19.            )( u) N, d/ e7 N/ C. E0 C2 ~& Y
  20.            "\"  M& h% r) W& l+ D' k- `
  21.          ), R6 E* n- Z; w; \
  22.   )
    ' P; M# d6 P" s9 p& D# T
  23.   (setq OLDLSP (getvar "ACADLSPASDOC"))! s$ b& r& e6 B
  24.   ;;保存系统变量值$ ^. m8 t/ M8 v7 g) W
  25.   (setvar "acadlspasdoc" 0)
    " W1 Y- P# b! C$ ]4 X
  26.   (setq dwgname (vl-directory-files path "*.DWG"))# q( a# T0 p; Q) U/ @
  27.   (setq num 0)0 m0 d4 ~6 z% V( ]+ H/ t
  28.   (if (/= dwgname NIL)
    6 y$ P( t3 t' `: b1 g0 n
  29.     (progn
    % M0 i* l3 N5 a+ E
  30.       (setq APP (vlax-get-acad-object))        ;获得Acad 对象
    # L; V2 G; e! c. c7 C! @
  31.       (repeat (length dwgname). b, {/ Z  @# }7 J" I3 L' V
  32.         (setq DWGNAME2 (strcase (strcat path (nth num dwgname))))
    # r+ E' ]' g7 J
  33.         (setq doc (vla-open (vla-get-documents APP) DWGNAME2)): j+ |$ N" g& n- s( H# d
  34.                                         ;打开图形并获
    5 n" f" }2 o! ~- O
  35.         得其对象
    7 x7 [; A1 t  d
  36.         ;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。
      }. R: J; s7 r4 K9 Q7 g; X- m
  37.         ;; …4 o0 g& ]2 C$ F
  38.         ;; …
    , ^$ L$ W# z/ Y7 s$ X, F( e7 d
  39.         (vla-close doc :vlax-false)        ;关闭图形(不检查是否保存)
    4 j+ L/ }8 K8 y( q
  40.         (setq num (1+ num))0 n, K' I1 v1 N+ {" z
  41.       )8 M/ E1 E- g/ T. [
  42.       (vlax-release-object doc)  v% R* U# P6 A6 O
  43.       (vlax-release-object APP)- \$ M! }8 |- m4 c, `6 {' L7 ]
  44.     )) J- P" P% Y4 R- ^9 v! M0 H8 A0 d
  45.     (prompt "\n所选目录中未有任何图形!!")
    # A! I& n; r* r3 E4 ?7 |
  46.   )- t+ |- |/ m' o/ }$ d1 j! ~( z
  47.   (setvar "acadlspasdoc" OLDLSP)% \/ f9 ]; Q6 C1 [5 k3 d9 W) ~
  48.   ;;恢复系统变量值
    4 [& r9 ~" W2 I% C; K  G) o
  49.   (setvar "cmdecho" OLDECHO)! ~- C! Y1 i2 @4 D/ d
  50.   ;;恢复系统变量值  l/ ^1 d$ |. }* J& V7 d
  51.   (princ)8 B/ _* r+ C; u
  52. )
复制代码

GTEXT.rar

844 Bytes, 下载次数: 15
回复 支持 1 反对 0

举报

发表回复
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则


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

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

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