高手请帮忙在这个程序加个功能

A云

这是个动态查询的程序，想在里面加上一个可以查闭合多段线周长的功能，显示出周长的长度，还显示一个周长乘以可以输入的一个数的等值，这样方便用来查线割的价钱，有哪位高手可以加上去的请帮帮忙，谢谢了


0 y8 h) ^8 Z, v6 {! F
(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
                                                  ；；输入一个实数

(defun myerr(msg)
4 M$ o9 |0 L3 @: I(setq *error* olderr)
(command "_.undo" "_b")
- ]$ M' x! g" _# P1 ]7 y8 I) i! H(princ)
8 `: G4 I* I6 d)
/ B8 T' d9 E0 r& w: z$ D9 e(defun dxf(ent i)
(if (= (type ent) 'ename)
4 q: Q! _! [, E( }7 V(setq ent (entget ent))
- q) {5 l: Q. W* o$ ~)
(cdr (assoc i ent))
* [! w. [0 c, n5 O6 M)
' `$ |7 Q- S$ o% y(defun toang(ang i)
(if (= i 1)
$ I: o% r6 |4 k2 S(* ang (/ 180 pi))
& q; [. t' a; y( o3 {" h6 i(* ang (/ pi 180))
# F$ Q  y' ^' B)
)
4 ?- d# h5 M- Y* j! }6 u(defun fx(ang)
(cond
((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
% }! d3 Y) g0 g# l((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
3 a1 u4 w* s2 x  L& y)
/ w9 w9 B4 l9 ~$ A  A1 l! F)
(defun add_solid(p1 p2 p3 p4)
! F8 u# q' ^5 k5 L2 }) ~6 y( w! B(entmakex (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 62 1) (cons 100 "AcDbTrace")
" P5 m$ v- C* z' H1 b5 y(cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)
)
)
/ s( t* z1 C9 _: {6 B9 M  Z- s)
(defun add_text(pt h ang txt style jus)
(entmakex (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 2) (cons 100 "AcDbText") (if (= jus 0) (cons 10 pt) (list 10 0.0 0.0 0.0)) (cons 40 h)
2 j& W# b+ p1 V* x8 T(cons 1 txt) (cons 50 ang) (cons 7 style) (cons 72 (cond ((= jus 0) 0) ((= jus 1) 1) ((= jus 2) 1) ((= jus 3) 2))) (if (= jus 0)
(list 11 0.0 0.0 0.0) (cons 11 pt)) (cons 100 "AcDbText") (cons 73 (cond ((= jus 0) 0) ((= jus 1) 2) ((= jus 2) 3) ((= jus 3) 2)))
)
/ f) \5 C# e! V) b/ C# l7 R)
)
(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
6 x/ S+ S! j1 g(setq obj (vlax-ename->vla-object ent))
: O- k) F# @% `; B(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
+ `7 n2 X: W' s2 u4 a; z(cond
((= name "3DFACE")
(setq lst (list "【三维面】" laynm))
)
- `) m7 N' y4 X8 G((= name "3DSOLID")
(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
% T$ Y1 j& N) L, P; x1 T8 O; y  x3 l((= name "ACAD_PROXY_ENTITY")
+ ]% [9 x- p: I2 k! ]) H(setq lst (list "【代理】" laynm))
3 k- r  c8 |# t: {0 [)
((= name "ARC")
+ g8 e5 X( v/ p0 s; Y- e(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "圆心角:" (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) "度")
(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
+ h2 v* g+ H+ g+ h4 B(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
))
7 L0 A8 \( T0 l( ]! C1 g* ])
((= name "ATTDEF")
* y- U% W8 a& h; H(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
# r& Y+ H% {% h(strcat "提示:" (vla-get-PromptString obj))
4 e9 I/ ]/ R! D/ i6 }(strcat "缺省值:" (vla-get-TextString obj))
! o$ S. g) }* O(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
" _: l0 h$ e7 O(strcat "文字样式:" (vla-get-StyleName obj))
))
! T& q# h* W  R0 f2 B( l)
2 n3 ?- |" w2 O: x, w((= name "ATTRIB")
(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
" D0 R0 h. u& t3 F0 b(strcat "缺省值:" (vla-get-TextString obj))
. H* Y- ^% l1 t  b(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
0 l' m" @1 D9 \3 b/ I5 @(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
) Q+ ]( s2 u. E5 j' E(strcat "文字样式:" (vla-get-StyleName obj))
, E# u" p/ M1 R; [* C))
)
((= name "BODY")
" F( Q% P! `( I" b2 ^& M/ @- p3 V(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
2 g) w6 k* x, n8 A" @)
((= name "CIRCLE")
(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
5 E' u: _) l+ N  ~2 t9 D(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
# w' J) k: x. Y- q; E( R. K)
((= name "DIMENSION")
, [  s& ^- q& h: a) D( ?+ X(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
- G* k4 x/ ]) C) H) j3 U2 g) J0 G(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
/ K/ s) G6 P7 y( Q9 g' r- G(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
" V8 U" s. m$ |! L; K))
9 _! G' W  W: p, k  U)
  E8 d6 S, ~4 V((= name "ELLIPSE")
3 G8 C. H- _7 J+ k: R& ^(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
( u: e( s$ B, h1 L! O) D(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
/ m. H& ~3 z( `+ t3 Z))
)
6 n) W4 {1 K( L2 d. f' z- N((= name "HATCH")
! e" Q2 g: B/ C* [- f) [4 Z(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
3 \$ z. Z; w0 S2 A% h0 m9 ~(strcat "角度:" (rtos (toang (vla-get-PatternAngle obj) 1) 2 1))
(strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
; L4 F% z2 E( G( K$ u7 Z(strcat "关联:" (if (= (vla-get-AssociativeHatch obj) :vlax-false) "关闭" "打开"))
/ V7 A1 [% ^& U; J% X% B(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
))
)
$ y) @& Q2 a* a$ y((= name "IMAGE")
( q4 f# W+ V- w' n(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
+ ]# N9 p8 i6 p, C. G: ?& \)
((= name "INSERT")
+ H; b' \% I( q! k" i: f(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
(strcat "X比例:" (rtos (dxf ent 41) 2 1))
(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
, w, S/ O5 V' V& U3 P( n(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
* W0 l" L! ]& k$ q7 r/ l1 K))
)
* }; s5 l4 D" M; H: ]* \/ j((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
6 ?, d1 C0 f" B: O2 E(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
" q/ R! Z6 O# L))
)
1 T% N, `3 u, y3 l4 d( Y3 r( b((= name "LINE")
(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
5 k0 _& k3 k! P4 N! U- C(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
))
)
; I0 W. m* E& a, y' p((= name "LWPOLYLINE")
$ v3 L, Z! q4 l5 N; B(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")

                                                           ;;加上一个可以查闭合多段线周长的功能,显示
                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
)
((= name "MLINE")
, x9 w& e" S! y! q; k(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
: i5 f, s; [$ f(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
! w' Q% P) m  s! Y' c+ ](strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
3 P$ Z8 Q, j* m9 H) B4 C% C))
)
5 F( D" `# n5 G) `, s((= name "MTEXT")
) r& Y+ m) P' ~(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
( d3 Z' s; M+ O8 w/ V, J(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
0 {0 U' u. V& r(strcat "样式:" (vla-get-StyleName obj))
))
- k1 \5 n" e/ q  D; n+ t5 u)
  @% o" K- N" J5 L9 J& f((or (= name "OLEFRAME") (= name "OLE2FRAME"))
(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
4 g4 [2 I" @5 Z' Y- X)
((= name "POINT")
! K. i& _8 q* q% l(setq lst (list "【点】" laynm))
. H4 m  @2 a* |8 [)
((= name "POLYLINE")
(setq lst (list "【三维多段线】" laynm))
0 Q8 ^$ ~! m1 @3 ]( A5 t# w5 D- [)
((= name "RAY")
! `: o+ F4 N! H3 H' j, u) q(setq lst (list "【射线】" laynm))
)
((= name "REGION")
4 T' U$ ^8 g0 |2 f(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
) m' R9 ?1 Q% Q( }/ s, q)
((= name "SHAPE")
' j0 U! @) h5 k& Y+ O) Y9 s- v8 d; }(setq lst (list "【形】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
( d. h/ J7 j( e))
)
$ U- O. G& u7 b((= name "SOLID")
' K' v1 C+ q- U. a/ w1 e% s(setq lst (list "【实体】" laynm))
)
((= name "SPLINE")
* w4 n1 O; a: q) {(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
. k& |% S+ o  V4 b1 ^6 f(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
9 z. V% p1 A: n/ M/ P))
7 S) v% I# v) |0 @" i9 Y9 i! H4 b)
/ L9 m( Y) v& J1 T5 o((= name "TEXT")
(setq lst (list "【文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
' Y( @0 B9 y3 i0 `7 g0 n; D' m(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
" ~/ t2 C/ m! c(strcat "样式:" (vla-get-StyleName obj))
2 ]6 F+ z' c! s( c' D(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
4 ~: }- p  M9 j% p6 }6 I" v% ]5 G)
+ L3 P7 h+ }5 c- G((= name "TOLERANCE")
(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
4 i" m9 b3 e4 J0 o2 u; m6 T(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
8 f) {9 _$ y; @))
0 I. f5 F/ `3 C5 F)
' d! M. s1 j8 m1 S' a! N((= name "TRACE")
(setq lst (list "【宽线】" laynm))
)
((= name "VERTEX")
( x7 ~& H1 ^, e7 J2 |(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
3 @4 q$ p4 `1 W- p! o1 b! v+ V(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
(strcat "凸度:" (rtos (dxf ent 42) 2 1))
))
: O% O% z& |1 v)
! ?. ]/ z9 J7 q7 A1 Z: r((= name "XLINE")
(setq lst (list "【构造线】" laynm))
)
(T
(setq lst (list "【未知对象】" laynm))
* A; A) v2 c: A)
)
5 _) |: B* Y; U0 U8 b(setq ss (ssadd) h (/ (getvar "viewsize") 50))
9 h( H% O/ l( }3 O, _5 P" z7 G& i: V(setq ang (fx (angle (getvar "viewctr") pt)))
(setq n (* 1.4 (1+ (/ (apply 'max (mapcar 'strlen lst)) 2.0))))
(ssadd (add_solid pt (polar pt (car ang) (* n h)) (setq pt (polar pt (cadr ang) (+ h (* 1.8 h (length lst))))) (polar pt (car ang) (* n h))) ss)
+ R4 p8 T3 c: M/ n; D& a, H(setq pt (polar pt (car ang) (/ (* n h) 2)))
: U# m- d% W! a, e9 p4 `( }# C; p(if (= (caddr ang) 0)
1 i- ~; p4 l8 j0 u8 I(setq pt (polar pt (/ pi 2) (* 0.4 h)))
(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
)
(setq n -1)
* w1 Z( d& |; U0 I(repeat (length lst)
(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
)
)
) R( N7 P5 \: A(vl-load-com)
; A5 ^) i5 C( }8 ^: A0 W(command "_.undo" "_m")
(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error* *error* myerr)
% e. w9 f. ~" i7 u( [. s3 S(setq oldos (getvar "osmode"))
(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
(setvar "fillmode" 1)
9 O( G7 y3 H8 y9 |, S" l(setvar "cmdecho" 0)
(if (not (tblsearch "style" "宋体"))
! F# J) m2 g4 f, }- ](command "_.style" "宋体" "宋体" "" "" "" "" "")
)
(setq ss (ssadd))
6 l8 A$ t9 t+ c  q# X6 Q(while (not pd)
. f0 z/ `8 H; A( `* W6 c" B$ v* z3 J(while (not (progn
! b0 V2 w1 _( Q/ T% s% S(setq gr (grread T 1))
4 F) s  c$ h7 L! p5 t(if (= (car gr) 5)
(setq pt (cadr gr)
ent (nentselp pt)
( V# t9 o/ @5 j; gent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
(car ent)
)
* \% p# ^) [; P& ?4 C; p' E)
/ _' Z9 q; U, [% j(setq pd T)
)
' t. }, ~0 B/ R% c( T. l: @))
)
(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
0 t/ a. U; b$ l(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
2 ?- }' Z$ c# v% J, Y4 @4 P+ c( a(redraw ent 3)
(dis ent)
(setq entold ent)
)
)
)
(if entold (redraw entold 4))
, }) p! h4 l5 x( ~(if ss (command "_.erase" ss ""))
: x; l: T5 q/ m6 c(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
) c3 \0 u6 z% P; M( k5 |1 V' |- n(setq *error* olderr)
* L  U" \8 Z3 U6 W! V4 p(princ)
* R5 i' V9 k! \" _+ I* A)

十二月

这可以得到任何种类曲线(包括LWPOLYLINE)的总长
1 `: g+ \0 c1 i% D(vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
希望对你有帮助

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长