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

A云

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


(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
6 S& W' W: [* ~1 ]                                                  ；；输入一个实数

(defun myerr(msg)
9 S+ q- N- q, \9 V3 u(setq *error* olderr)
6 D, o9 {) B) N# a(command "_.undo" "_b")
: |1 Y+ J* ~7 n! v, E- N! P: u! }(princ)
& `8 T; o: t5 R5 i. Z" h& u4 ~)
(defun dxf(ent i)
' |& C& O& {  ~(if (= (type ent) 'ename)
; ~  @: x; l  m: c(setq ent (entget ent))
8 L3 l# I8 a8 G' o, {8 U5 l) e)
(cdr (assoc i ent))
)
9 N9 z1 t7 a8 e0 P(defun toang(ang i)
(if (= i 1)
(* ang (/ 180 pi))
' f, D0 q9 f. j2 R- V! _$ \(* ang (/ pi 180))
" V  `  M/ r7 @- ]7 C( M# n)
)
2 v, }: L; Q% L' `5 p(defun fx(ang)
(cond
# b% |+ e+ f5 d4 R- H- y& x/ J; b((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
9 {2 |( ?2 k3 u" ]# j! ~- w3 L((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
)
)
(defun add_solid(p1 p2 p3 p4)
(entmakex (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 62 1) (cons 100 "AcDbTrace")
. Z4 X/ k: C% N9 i, i& x5 q- O  s(cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)
)
)
2 o& \$ [, q0 w3 X( y)
(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)
(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)))
, K5 n, M1 m1 v$ Q) ~7 }% p/ S% M)
)
)
6 f) G9 y' w8 m5 A(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
(setq obj (vlax-ename->vla-object ent))
+ q( F5 Q: c/ C; I7 r(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
( `$ t9 U! z8 F5 L(cond
" v. c# m; g$ h& k1 f* k6 M((= name "3DFACE")
(setq lst (list "【三维面】" laynm))
)
((= name "3DSOLID")
(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
1 N$ P4 _( e& P)
((= name "ACAD_PROXY_ENTITY")
; ~0 g$ O/ V$ I/ o& J9 w(setq lst (list "【代理】" laynm))
3 A* A$ Y0 T6 s' l) A, d  S9 g)
((= name "ARC")
" W% F- U( C! t- o: ^3 x( B" G(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "圆心角:" (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) "度")
, R0 m3 O0 Q, k2 w(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
: c# ~+ X# m* u7 Z(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
: `% h" _8 W, @))
, b7 u" R7 f3 _0 X/ I7 f' @" a)
2 J+ l3 ~) z( S, m((= name "ATTDEF")
4 M8 i+ E  K# D1 r(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
0 Z4 a+ Y. H* M. n' @! S5 c: B  r(strcat "提示:" (vla-get-PromptString obj))
5 U# x9 h. Q' i1 _2 ^; W; \(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
  ]6 `% s8 g  s1 ^9 l(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
4 D+ f6 F( E' k: c0 x3 f(strcat "文字样式:" (vla-get-StyleName obj))
))
  T( P, \5 \' p)
" [8 v3 {8 d. p& _/ i((= name "ATTRIB")
1 Y- U1 r+ B* W2 ~; t4 }' t(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
))
& w2 n" r! R. g! h5 U) q)
((= name "BODY")
(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
. E  p  X" z# _% u3 D)
2 V) {/ X1 k1 q4 n# ]$ k  \((= name "CIRCLE")
(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
6 W, R8 w* R- r)
((= name "DIMENSION")
7 g- ~3 i. s6 u9 T+ N# C2 C9 E(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
  G2 x; u9 ^" a2 d. ?* M(strcat "文字样式:" (vla-get-TextStyle obj))
* t1 k2 W! t6 ^  T: X0 E7 s( D* ~(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
3 P2 c, q( w6 _7 {& D))
/ H8 B0 B4 q+ j  E: e)
((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
& X, N. `/ G6 {8 ?6 b( }(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
: r6 \5 c: W$ Q/ a6 J# l(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
$ N" ~. o. `& f(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
$ r8 q# |7 s" Z) {# x)
((= name "HATCH")
4 q* d3 E. O* k' N(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
, s8 A! P* O: j4 U) F5 u0 V(strcat "角度:" (rtos (toang (vla-get-PatternAngle obj) 1) 2 1))
" t; e" E5 P* [(strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
) n4 b) V8 Q5 y" W& |" K(strcat "关联:" (if (= (vla-get-AssociativeHatch obj) :vlax-false) "关闭" "打开"))
(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
  H2 [- [8 [( c2 K! t))
)
% }" F$ e7 l* h" \((= name "IMAGE")
(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
" [( Y# e- }+ f* L$ O)
((= name "INSERT")
(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
2 D6 I! p$ I- ~$ h8 T(strcat "X比例:" (rtos (dxf ent 41) 2 1))
, R$ X$ h) O9 U' D& b, K6 a(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
)
, T) L6 I7 r: _! i((= name "LEADER")
+ B' R) u. ^' }: {. z; d(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
6 J9 \2 g  o4 \4 E  @- k9 L; d, ~- G(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
))
+ o6 S- {4 Y, R% K% m) }% Q)
((= name "LINE")
(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
- r& p0 z* |3 F" z! A- D+ q, k& o0 @2 _(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
% X* a1 [0 U" k1 d/ Y))
3 f0 f( _# T  K( O' z/ N)
* e& d+ ?$ t7 V! L( b+ R) R((= name "LWPOLYLINE")
(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
5 {4 H! q1 i! f$ P& ~: X) `; c(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")

/ K* b) F  y6 c6 C( A( ^/ A                                                           ;;加上一个可以查闭合多段线周长的功能,显示
2 p+ t) U1 x( r$ ?9 k0 z7 b                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
+ _4 R3 x5 ~- E9 v2 j) K! j2 E, R/ d)
7 h- b1 i/ W0 d4 ]((= name "MLINE")
5 B/ P) T, g# \6 q; n6 w! d2 ?(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
6 t, f  J2 V& R' }; b(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
))
1 E0 U" k7 N0 {8 x6 |)
8 D* x! a- R  f& q* y((= name "MTEXT")
% x; q2 i: [* e, D(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
, G. W. ?) r( P1 m(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
1 a' A8 m# \+ a+ b(strcat "样式:" (vla-get-StyleName obj))
))
)
((or (= name "OLEFRAME") (= name "OLE2FRAME"))
(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
, ~  c' Q. \. S) P) z& k* v0 G+ T  A2 _((= name "POINT")
' S: o, G( W  G2 u% b2 k+ [(setq lst (list "【点】" laynm))
)
3 U, K% q" n, F  S+ |/ S: _((= name "POLYLINE")
. }7 j1 @0 W, q+ d1 u, X(setq lst (list "【三维多段线】" laynm))
)
((= name "RAY")
(setq lst (list "【射线】" laynm))
7 D  C- `0 R+ u6 |3 X9 t)
, ~- i* [5 g; d4 _! z) Y((= name "REGION")
7 h+ o4 r2 u* P* Q(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
3 b* ^& H$ d0 V  o)
((= name "SHAPE")
4 b7 m: ^$ t3 ?$ P& |& C$ Z: ?/ h2 n(setq lst (list "【形】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
( K0 t6 ^# |# m(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
7 b7 \& \& J- V, E' b))
! j' _# @2 M- L8 C9 E  w  L)
3 S+ J3 E. |! O((= name "SOLID")
; A! F* C; C" t: E/ @8 l9 i(setq lst (list "【实体】" laynm))
)
% b: V4 g% s" n' U* [5 c- }((= name "SPLINE")
(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
2 j- @1 j& W. K( o- ?+ E(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
4 T* N. `& I. u: Z6 n* }8 \% N3 Y))
$ O0 z+ n- l9 V% x)
((= name "TEXT")
" T. Q8 r) @3 j& i  {(setq lst (list "【文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
9 b' F' ^( ?1 H- k. Q% y% g(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
8 j% r* r  O% }  U(strcat "样式:" (vla-get-StyleName obj))
9 a7 H, q: e! d& i5 s1 M(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
, h# p7 H  K7 w8 z"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
)
+ o+ h5 J- h- X7 q! |((= name "TOLERANCE")
# |; T9 l9 Z: b% i: i(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
" p( P$ U) m& x2 Q4 u; F(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
))
; q3 j; S* a3 @- h# {. q)
((= name "TRACE")
, [. l. c1 g$ }) q5 H/ i(setq lst (list "【宽线】" laynm))
)
((= name "VERTEX")
+ X; ?$ _" W7 ^7 d4 h; h(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
7 d  ?% B7 ^$ e(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
2 I2 g8 X5 j) p" I- ?(strcat "凸度:" (rtos (dxf ent 42) 2 1))
& y  i$ t1 y3 }& ^  g9 }0 S))
)
; o1 r( A9 M$ `* o9 |  s9 r6 e((= name "XLINE")
- L% f: i2 v# y3 w( j7 Q& ?(setq lst (list "【构造线】" laynm))
: r, o1 v. V4 j)
(T
(setq lst (list "【未知对象】" laynm))
)
)
0 {! a9 ~, y& E(setq ss (ssadd) h (/ (getvar "viewsize") 50))
(setq ang (fx (angle (getvar "viewctr") pt)))
(setq n (* 1.4 (1+ (/ (apply 'max (mapcar 'strlen lst)) 2.0))))
7 L7 k3 r- x; S9 z0 O6 X(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)
(setq pt (polar pt (car ang) (/ (* n h) 2)))
(if (= (caddr ang) 0)
. e  D/ H7 {  D+ x9 d, I' l! L$ ?! c(setq pt (polar pt (/ pi 2) (* 0.4 h)))
(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
: X! c% M) M) v0 E3 J' u" _/ ^)
1 j; }+ z$ }" o( h(setq n -1)
(repeat (length lst)
+ V0 h. p7 D. {8 @- n" s(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
)
)
(vl-load-com)
. r' w2 Z  n7 Y3 C3 }& y8 c, [" l(command "_.undo" "_m")
9 Z# p/ y# B4 r3 ~3 B2 @(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error* *error* myerr)
, P+ K9 M$ u2 ~  s4 P# @( W8 j(setq oldos (getvar "osmode"))
/ V3 B2 F0 e$ `9 ^9 V  ]# N(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
9 C! i# |) o& }(setvar "fillmode" 1)
(setvar "cmdecho" 0)
(if (not (tblsearch "style" "宋体"))
) ?# L5 U5 F% w(command "_.style" "宋体" "宋体" "" "" "" "" "")
)
9 f7 I5 b) O  `(setq ss (ssadd))
(while (not pd)
(while (not (progn
3 B% N! N) x6 e4 Y$ |* [(setq gr (grread T 1))
(if (= (car gr) 5)
' X% J3 _7 e9 S# s; u5 s(setq pt (cadr gr)
ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
) E& }8 Q" l. m2 j(last (last ent))
(car ent)
)
! k" e( U& y2 y& w0 Y)
(setq pd T)
- I& i$ J2 Z; A5 h9 `)
3 J* \) g4 k- ]5 Y))
)
$ n: _9 O8 U" S( ^4 W* c(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
; \7 P$ l8 C( [0 d* `(redraw ent 3)
(dis ent)
(setq entold ent)
)
)
)
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
, g. S8 w. a* m, V6 F  L(setq *error* olderr)
& G" ^# B4 c  p5 l9 [' J(princ)
" \- T1 t, V; q0 q- W)

十二月

这可以得到任何种类曲线(包括LWPOLYLINE)的总长
* [! f% ]6 n% @7 Q5 \" ?/ J(vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
希望对你有帮助

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长