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

A云

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

. Y0 |1 \. S2 M" A1 i* e0 o8 ~) i
( C7 T; `. T' s+ g$ W(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
                                                  ；；输入一个实数

(defun myerr(msg)
2 }0 p4 l$ G3 }- h/ F& s(setq *error* olderr)
" z5 H7 H- c/ C$ F& V  c, D(command "_.undo" "_b")
3 [3 M! D2 J, b- B7 L; }(princ)
6 J( E( ]0 j% L6 L0 T4 t)
* k: M( L0 ~2 ?(defun dxf(ent i)
0 _$ U, @7 z$ u6 ~(if (= (type ent) 'ename)
(setq ent (entget ent))
' J8 b/ t: ^& g  n)
(cdr (assoc i ent))
)
  d3 L  {5 I* ~' d$ c* L(defun toang(ang i)
(if (= i 1)
  d% L5 b9 q& A& k(* ang (/ 180 pi))
# m1 u) ~- V5 b& u5 y5 |(* ang (/ pi 180))
8 F3 a4 j: N3 J0 t)
6 u6 X- C5 H% H1 r$ l# d: l)
(defun fx(ang)
. q7 U% k0 g' ?8 c2 n$ D# a6 E(cond
$ x" s! [1 D1 e((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
)
)
* B& c/ t' z: e# r2 }( S, B9 n" `(defun add_solid(p1 p2 p3 p4)
: b- h, K! _  D# V# V; ?, V(entmakex (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 62 1) (cons 100 "AcDbTrace")
(cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)
1 m: o5 ^! ~: I" \' c)
)
8 p: Z. y8 @: ?2 g)
+ K) B9 `' {( @# z5 g  d(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)
+ ?# t7 o9 I$ [6 t5 w3 n) A(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)))
1 o, s8 J/ w" D, y)
)
)
; \, J6 Y' e; G(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
* H( |9 J  O( a9 x3 ~(setq obj (vlax-ename->vla-object ent))
9 Q- m3 G- B$ u' i(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
(cond
4 e- X. P0 X+ S7 e((= name "3DFACE")
, X! }+ J; W( i2 Q! M4 v7 U- i' ](setq lst (list "【三维面】" laynm))
( l; C1 g# A( v+ P* \5 J* q' M)
((= name "3DSOLID")
/ L/ ]/ J; G) e% M6 j8 I) s(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
4 \! s2 s8 i$ Q. w/ v" u* [* Y0 a)
: g9 a0 B  P4 u3 J((= name "ACAD_PROXY_ENTITY")
/ C0 p0 Z) s* U(setq lst (list "【代理】" laynm))
)
* Q( ]6 o" _$ h  f  |((= name "ARC")
(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) "度")
+ u# g7 Y, f0 U& T4 c(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
  O4 a% `, N  {$ _(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
: ?5 h! |* P8 l! n  g))
9 M6 p5 _: H: i0 y7 u2 R)
((= name "ATTDEF")
; a0 p; m6 u* M9 [' I' c: d(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
3 v9 E7 O; i' V  e1 [6 Z8 ]; z(strcat "提示:" (vla-get-PromptString obj))
(strcat "缺省值:" (vla-get-TextString obj))
& n. S' A; s* ?! Z+ ~  t/ {(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
9 y- t& \% R8 Y9 A(strcat "文字样式:" (vla-get-StyleName obj))
1 v$ ~% z7 q( s/ U) F))
' H9 T, d( p3 a6 E)
((= name "ATTRIB")
' M) z& D  r, `  X(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
& X3 z+ @; K. V' P+ y. U4 `$ |(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
; z' t7 T0 S+ _* ^(strcat "文字样式:" (vla-get-StyleName obj))
))
* d" V/ M- N0 `5 C0 ]( }/ M)
((= name "BODY")
(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
4 V) k: o9 A6 r5 I7 y+ u% q9 I)
((= name "CIRCLE")
7 q3 M+ P( i* |; K6 A8 ^(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
# p* L8 V; i4 l* G. m3 X(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
)
((= name "DIMENSION")
(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
, |; c4 n2 B/ C( [(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
, N2 p' F" Q  `( C6 o(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
' P) l) c3 v9 Y* N))
+ v8 e/ H" n0 ^- ~4 X" k)
' T/ Y- U9 J9 c3 t7 x((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
" W! {5 H% v$ z$ |: ]) R4 W1 b(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
( h8 }9 Y8 B" o+ N# b$ {(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
2 G/ l5 s9 D3 u: E6 M, |1 P)
((= name "HATCH")
(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
! s$ N. A1 M# R) E& P(strcat "角度:" (rtos (toang (vla-get-PatternAngle obj) 1) 2 1))
( n( r/ g$ v. ~7 O- C1 R/ u(strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
( x  Q% Y. Y& {& u- k* ~' _(strcat "关联:" (if (= (vla-get-AssociativeHatch obj) :vlax-false) "关闭" "打开"))
(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
: w! l, K& W! C6 R2 N))
)
3 D( P( K% Q7 D1 t  B((= name "IMAGE")
(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
)
((= name "INSERT")
(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
(strcat "X比例:" (rtos (dxf ent 41) 2 1))
5 _# X; y0 b3 K+ C8 o9 k(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) "度")
  f( l# H4 e4 _7 {( Q/ u))
)
((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
& f, C, ~* J! j; v6 }7 |2 T9 p$ h))
% b- Z, [$ a, q- M* b/ H9 }, e1 N)
8 J' h8 b% l$ s6 D' J' Z5 a((= name "LINE")
1 [6 t9 L" ?% k* z(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
& z- ~) {! m; m+ _& K(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
2 h- t9 w6 @! g4 r  T6 ^))
( [; S+ ?; C4 V0 N)
((= name "LWPOLYLINE")
(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
+ l% a8 S! D7 W' T% \2 Q! ~0 D0 X- K(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
/ {5 K, R2 C3 L; I4 i9 [4 Y8 O( g  i$ b(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
3 B$ z1 u0 v5 |$ K
3 F9 S2 J' y6 Q: U5 [                                                           ;;加上一个可以查闭合多段线周长的功能,显示
$ X, D$ q; o8 L8 g! F                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
3 g( a  q: X* d5 M8 L- c' }# Z5 r)
((= name "MLINE")
+ G% U, @( }1 g# Q(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
4 V$ t- N) p" s% S' G$ z0 q7 X. n(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
% P8 h+ c) _- ]+ I(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
))
! M1 X5 d" I7 X3 r. l)
) V1 ]9 [3 L. J: u% r((= name "MTEXT")
(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
- n" }: Q/ b0 H. s4 I(strcat "样式:" (vla-get-StyleName obj))
))
. s( N5 t2 m1 b, s. T)
4 _& v$ |$ t+ n4 j((or (= name "OLEFRAME") (= name "OLE2FRAME"))
0 j% u5 k4 z0 ?1 W(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
  P& [: H. f4 x! V( O((= name "POINT")
(setq lst (list "【点】" laynm))
)
((= name "POLYLINE")
(setq lst (list "【三维多段线】" laynm))
3 f' Y9 e, r2 J)
; S1 L9 {# D# J8 ]& y# ]2 Y6 s((= name "RAY")
2 r% Q3 X1 y6 T) b& L3 j6 ](setq lst (list "【射线】" laynm))
+ W# B- ?+ |; R$ g" b" A; x7 \+ f( d)
((= name "REGION")
(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
3 _7 e2 f; C, s9 B$ b' H  q" D8 ~)
((= name "SHAPE")
/ h  [2 _& {& N, r! s+ h(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) "度")
1 J2 u# U2 v3 D8 m* Z/ L& h- Z; n))
)
((= name "SOLID")
(setq lst (list "【实体】" laynm))
)
$ r* |( ?/ D* f6 m0 v# W+ B((= name "SPLINE")
& D3 Q" }( ]+ Q2 W( D9 W1 i(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
)
- I9 r4 ^5 P% s; N((= name "TEXT")
(setq lst (list "【文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
# @! G4 K/ M. d% i8 U(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
& u+ ]% O, I# e5 g, i(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "样式:" (vla-get-StyleName obj))
; `  J0 l% R" j; I! g- s4 `8 K% p4 [(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
; X2 h% x$ Y  \1 ~"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
0 J# g. X8 {8 }( x& q)
((= name "TOLERANCE")
(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
, }$ D0 {: A) d. w" p(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
0 @- ]3 ?- K5 R1 c& m))
9 |: e! [1 b$ U/ a)
  I6 {4 _) B, H; K0 {((= name "TRACE")
(setq lst (list "【宽线】" laynm))
9 `9 H) J  ^$ u; u)
9 J8 j& c" @! l. Q& \((= name "VERTEX")
(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
% a0 ]9 s% X. H! j(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
(strcat "凸度:" (rtos (dxf ent 42) 2 1))
))
)
((= name "XLINE")
(setq lst (list "【构造线】" laynm))
) {; I8 U2 o  \4 J5 F8 a)
(T
- T- y+ w" _- l(setq lst (list "【未知对象】" laynm))
5 B7 v- J7 s  e2 i! ^. b9 K( h1 c; c)
)
(setq ss (ssadd) h (/ (getvar "viewsize") 50))
- S( _! D5 i' L$ f1 e: @(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)
! J* W- V5 i6 m7 X(setq pt (polar pt (car ang) (/ (* n h) 2)))
8 u7 I8 x  S# ]* C: \1 u(if (= (caddr ang) 0)
+ |! X+ k# ?. i' j7 ~* X; M(setq pt (polar pt (/ pi 2) (* 0.4 h)))
4 e: a" I# z7 ^# F( W(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
)
(setq n -1)
* @2 L% @2 p- c( h: |8 A8 |( y(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)
)
8 H* Q( I4 r" p7 Y4 y0 h% })
4 s0 n" u9 w2 b/ l(vl-load-com)
(command "_.undo" "_m")
(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error* *error* myerr)
2 ~( S0 W3 r6 d  t  Q- C(setq oldos (getvar "osmode"))
; ~* h( }- |4 ]- i- g  _1 t(setq oldfill (getvar "fillmode"))
* r% M3 S9 Q$ v' m% `(setvar "osmode" 0)
(setvar "fillmode" 1)
(setvar "cmdecho" 0)
(if (not (tblsearch "style" "宋体"))
3 {2 p2 c0 H$ t2 r+ W# s. }(command "_.style" "宋体" "宋体" "" "" "" "" "")
% U8 X( m& r0 F4 v)
(setq ss (ssadd))
- f5 }6 i# z) }: i$ E% U+ a(while (not pd)
5 @$ K. s/ t- C- A4 N* T0 N+ i(while (not (progn
9 @" ~; l: x9 I" Z9 d(setq gr (grread T 1))
+ d' E  l) A7 b$ B" Y; ~0 W(if (= (car gr) 5)
(setq pt (cadr gr)
ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
2 M; w! v+ n) ^(last (last ent))
(car ent)
)
)
(setq pd T)
( N$ L- G; m, J' X)
" \3 I6 i! U7 n))
( A& J# E! |  A2 W8 g! f+ c)
(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
) A9 b1 e. O# V# F6 c2 W(redraw ent 3)
(dis ent)
2 o+ ?, q* e, q(setq entold ent)
# E' ^5 W3 N9 f' c. A; r& Q) `0 M)
+ z; s# h, H% T% ~)
- v7 G# x0 c% d9 z) V)
(if entold (redraw entold 4))
4 K1 d7 T7 c# I" x$ s7 i% ?5 I(if ss (command "_.erase" ss ""))
. [$ ~% k4 |1 B* x(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
(setq *error* olderr)
(princ)
)

十二月

这可以得到任何种类曲线(包括LWPOLYLINE)的总长
. B2 @$ _( y; ^; X(vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
希望对你有帮助

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长