|
|

楼主 |
发表于 2010-1-17 15:19:47
|
显示全部楼层
来自: 中国上海
本帖最后由 zjf00 于 2010-1-17 15:22 编辑
; v" b9 S# o' H8 U" \5 G. o# y! X; |. z [3 r0 r' Q) y
等了好久也没有等到有价值的回复。% K/ A' M& V: q9 O" D' y
其实这对于会一些lisp的人来说真的是一件很容易的事
. M; Z7 f( S; _ U: J' a- d% p我没有学过lisp,不过依靠N久以前学过的一点点C语言的编程基础,再参照其他高手写的类似的lisp代码,总算凑齐了一段代码,解决了这个问题,现在发出来和有需要的同志共享一下:
4 K$ T6 i: w$ i% W! Q7 P7 u(defun c:dimdd (/ measure real result ss text) % }% p3 S$ v3 K' M3 x$ `
(vl-load-com)
% v! K1 v7 ?' S0 H* u7 t3 ](vla-endundomark # L- y9 d _; G5 t
(vla-get-activedocument ' v% x& F& D: g% R# U! f
(vlax-get-acad-object) I. c: E: g* l" I0 m: ]( ~. ?' }4 a% d
)
: E5 w; y2 `$ N' @! ^) V4 h% K)
" M) o+ W6 [# Y* l: g(vla-startundomark
2 Q8 k! ~! Y$ X C$ U3 |1 g) k L (vla-get-activedocument 9 x3 e5 {! D9 c& c4 |' z4 H. d7 t m
(vlax-get-acad-object) + g& Y5 j9 u7 Q
) " J( ]4 \1 t* }7 F; m, t
)
9 {7 o* }' Q7 Z5 c' J (setq ss (ssget '((0 . "DIMENSION")))) ' C7 m/ L* e" p
) E1 \# n a% I, U4 f1 T$ I7 n$ T
(foreach obj H& x3 d/ n% U6 Y$ y* S& e/ U/ f1 }
(mapcar
" y- M; ], c/ q- e: J& X3 x6 J 'vlax-ename->vla-object
: f/ ] J- _' e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
2 T% @$ l" J( P )
. r2 o7 R3 }* i (if (and (setq text (vla-get-textoverride obj))
7 t& {* j. ?8 c. I (setq measure (vla-get-measurement obj)) " j2 G% ~- x, n" B# |3 W: D1 j
(/= text "")
- d3 s8 `5 H1 j! E6 J (numberp (read text))
, @$ H% F$ q4 H' Z) D" v. m; Z )
7 _) n+ x+ { A5 L(setq real (read text))
& E( v3 ^; V0 [; D(setq real measure)
9 {, N" w5 Z) h9 F )
% P" c, X3 F5 u. w3 e7 B' V8 s (and real
0 T* k1 e$ i- ?& ?( c (setq result (vl-princ-to-string (+ real 0.0)))
! W6 J$ e( s+ E) t# W3 g (vla-put-textoverride obj result)
3 l' S1 h6 m9 }. J7 V1 u )
" w, z7 i- q! D" Z) n' ~ )
+ J- T7 A. l h+ C" F
% ` B/ s6 h" Z7 ^& |9 B(vla-endundomark 8 l) B9 F7 n9 H8 `* e& B( |* y
(vla-get-activedocument
q& i; {( b0 n, O: J: C (vlax-get-acad-object)
8 h6 e% t! U2 y )
9 Q+ i a) y* q( v) ' b& H2 [3 q* i& ^# t/ _
(princ)
6 X$ L) `) V+ ]9 X' h4 L)
' ^8 ?# \; O& t: A; o" I& G(princ "\n本程序作者: zjf00 ") |
|