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

A云

这是个动态查询的程序，想在里面加上一个可以查闭合多段线周长的功能，显示出周长的长度，还显示一个周长乘以可以输入的一个数的等值，这样方便用来查线割的价钱，有哪位高手可以加上去的请帮帮忙，谢谢了
( i9 Q5 o1 {) @) Z" d8 j. F" L* N

- m' h% ?4 q/ {5 u5 y4 v
(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
+ d; v/ v: {; v+ A, g7 l                                                  ；；输入一个实数
; ?& o- C4 {" b* I+ G+ ?7 R
; D) j8 Z. Q, m/ t0 l2 [(defun myerr(msg)
(setq *error* olderr)
(command "_.undo" "_b")
- V; J! A+ ?' x+ H+ I(princ)
)
(defun dxf(ent i)
(if (= (type ent) 'ename)
& Z6 a4 V; {( w! N) [(setq ent (entget ent))
" H) v3 a5 [$ Q' C' N) Z- I& q)
(cdr (assoc i ent))
)
(defun toang(ang i)
(if (= i 1)
, t3 e* _$ v* y7 U% s  S* `(* ang (/ 180 pi))
. ?8 Y/ p" `, }+ f( g' q2 L, s$ H(* ang (/ pi 180))
)
)
(defun fx(ang)
3 \7 K6 ]! _4 D) U(cond
((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
% f) j' C. M. H; l((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
+ a; E8 ]( Q; R0 l8 i* g/ N8 h5 j* n((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
/ z' N2 B2 h' {4 n((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
)
; e, v1 [# p  m7 [: j9 h6 {)
  x, V9 p! L0 D# \3 U7 ](defun add_solid(p1 p2 p3 p4)
/ J8 d7 i/ ]9 h: {(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/ J  n9 P+ q0 Z9 c8 P9 T)
5 W4 {2 B' G: J' [8 R7 U! h3 }. X1 a)
(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)
% I) }& A3 W' d# j2 Q3 I+ ~(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 X( b9 k3 [. H" Z) u5 t)
)
9 X$ R$ F$ c9 H/ y  ]) q6 X)
! `( p1 S& u, _(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
(setq obj (vlax-ename->vla-object ent))
(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
* V& ?3 `5 S0 k& O$ L3 d0 F(cond
6 n7 N- ^  E0 w  i6 a1 F((= name "3DFACE")
(setq lst (list "【三维面】" laynm))
: ?7 K' p2 O  K4 l/ d' ~)
((= name "3DSOLID")
, t" X! E0 e2 {) E$ m4 X5 V( Z% C5 m3 V(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "ACAD_PROXY_ENTITY")
(setq lst (list "【代理】" laynm))
& G+ J5 t& W2 f)
; h# K- u* c. |# ~: p, @1 x((= name "ARC")
$ j" i+ _0 S3 H/ G# _(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "圆心角:" (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) "度")
- F: N5 Y+ a# |, H/ T, ](strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
- ?0 N1 F$ B5 P  F/ P3 }(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
4 R! D$ c0 Q9 M3 X$ t7 i% M))
)
2 z% c* k: R  b((= name "ATTDEF")
(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "提示:" (vla-get-PromptString obj))
- V) w3 O0 n0 F3 r- f/ S, m(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
# w$ g3 q1 T  b$ }) ~(strcat "文字样式:" (vla-get-StyleName obj))
))
)
((= name "ATTRIB")
1 _5 j+ d1 F) o& T& T4 r(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
$ l& H# c! r- T- K6 h# i# r; R(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))
6 M; g9 t( q* o5 _))
)
((= name "BODY")
(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
7 h$ f% a' E5 d6 g7 F4 })
((= name "CIRCLE")
6 E/ M4 u" ?# B& [* Q$ x(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㎡")
))
)
. |3 A/ X- s0 t  X0 c((= name "DIMENSION")
(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
  y+ a/ l; X; E9 k(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
6 o+ \& b% Q% F8 r# u! j6 k))
; o/ z! P/ W4 i: Z$ z)
" l$ R, {6 h- r8 B5 ?((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
! G: c7 E4 Z7 @1 X) v/ N6 t(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
. V1 C$ {) d3 d# p( e1 K(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
" }% m: d, {$ p9 F" h))
)
/ z9 w6 p5 E: l3 k) X: T! [; N((= name "HATCH")
(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
(strcat "角度:" (rtos (toang (vla-get-PatternAngle obj) 1) 2 1))
- _8 v/ f! O! s* e(strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
(strcat "关联:" (if (= (vla-get-AssociativeHatch obj) :vlax-false) "关闭" "打开"))
(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
))
)
((= 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))
% d: J1 L2 s* t( X(strcat "X比例:" (rtos (dxf ent 41) 2 1))
(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
  U! o' Q* x& ^7 |+ O& u. x(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
0 f8 M& q+ n. E% n5 Z+ h(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
2 f0 F9 v: A$ b1 p))
" Q& @2 f! P6 k8 |)
((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
7 f# f% _: T/ e) a& h; L& n(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
))
  `; B. J4 w: n! w% J; R)
6 p! K. u& z3 t8 M2 X. o((= name "LINE")
(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
7 ^5 S, |8 U  ^& W- y(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
))
)
& R  u$ a8 T2 q((= 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) "不闭合" "闭合"))
* g9 S% t* N. x) E1 w* C8 c- E(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")

  v9 h* S( L! A- U) \! s                                                           ;;加上一个可以查闭合多段线周长的功能,显示
- B* x; y& s6 p0 W$ U+ D& \                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
5 \3 m- s2 w$ U)
% I( n1 J/ J% K& u((= name "MLINE")
  S; S5 a+ b) @" w- [1 G0 q* |(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
))
; J; M0 x" R* p& i( U)
((= name "MTEXT")
(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
& T5 V1 m# @' o! b(strcat "样式:" (vla-get-StyleName obj))
))
)
((or (= name "OLEFRAME") (= name "OLE2FRAME"))
(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "POINT")
0 B1 U9 j  H4 b- @8 P& v(setq lst (list "【点】" laynm))
. G/ A3 o9 f1 d8 T9 B# ^! ]1 R)
((= name "POLYLINE")
& P3 W/ W* ~. c/ A3 C" D(setq lst (list "【三维多段线】" laynm))
)
((= name "RAY")
9 k- e; @, h6 F7 H! h9 p. J, p! z(setq lst (list "【射线】" laynm))
: s5 P! F# E( ?: e/ t. m0 @)
((= name "REGION")
(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
( @# R5 W- A; E. ~2 v3 x8 j3 H/ b((= name "SHAPE")
/ I' O$ L3 H7 b( J! ]2 Q, p3 x7 M(setq lst (list "【形】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
% z" f( J) P, A/ A( \; o(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
, ?( \4 Q3 Y5 @% o% \  Q/ T9 ](strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
9 b4 c, C1 {( B& [)
$ Z( I" h, x6 P((= name "SOLID")
5 b) r6 d0 j+ H6 u7 f  z4 g: ~# M(setq lst (list "【实体】" laynm))
)
( e0 s( O0 e, g; T4 O7 G3 {((= name "SPLINE")
(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
. P( z. G& w  H' y(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
* t$ y3 h* P1 w$ m6 Q( t))
)
. ]" s; n8 v; ?3 d, g((= name "TEXT")
(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) "度")
  Y3 \: t( [* v' p" B. c' [6 f& \(strcat "样式:" (vla-get-StyleName obj))
7 K- }; G8 b  r3 i3 Q3 h* A(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
)
((= name "TOLERANCE")
(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
$ D: E7 Q0 h2 y: I1 r9 Q(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
7 O  m4 `( @6 O( B5 }2 T9 k7 @))
, Z- w# N4 J  {8 G" s, o# T# p% ~)
# \) ~& O- `* \, l/ |, D% \((= name "TRACE")
(setq lst (list "【宽线】" laynm))
) ~, t8 x3 J# K. x)
((= name "VERTEX")
(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
% {+ c% u- e- J$ J+ m; b- ?(strcat "凸度:" (rtos (dxf ent 42) 2 1))
3 G1 G/ v# R: j4 s5 n3 n+ i8 w5 U))
)
7 h0 P* @% S, N5 w2 z! v((= name "XLINE")
(setq lst (list "【构造线】" laynm))
)
$ U# J" `# ~2 l(T
; o, \; w1 D5 S( U! h9 u6 C& u(setq lst (list "【未知对象】" laynm))
! [& S' X9 t( |7 a( L)
)
0 o2 o/ a- Z. v; _2 ^(setq ss (ssadd) h (/ (getvar "viewsize") 50))
- |9 f7 R- A1 `(setq ang (fx (angle (getvar "viewctr") pt)))
(setq n (* 1.4 (1+ (/ (apply 'max (mapcar 'strlen lst)) 2.0))))
* |3 Y8 b' `7 v(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)
/ L  R# ?* V3 u& Y8 M: Q8 z$ Z(setq pt (polar pt (car ang) (/ (* n h) 2)))
(if (= (caddr ang) 0)
(setq pt (polar pt (/ pi 2) (* 0.4 h)))
& Q  e7 U+ u. l- n, V# e(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
)
( U$ B9 ]4 \: p0 a& |(setq n -1)
1 M, j$ {8 _' Y7 ]- U0 g# O3 G(repeat (length lst)
1 H4 X; e) S, z8 b" z9 ~(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
)
)
: |& L  V8 s2 N( a* q9 L(vl-load-com)
3 M* k$ ~5 Q# J3 I& ^. Q(command "_.undo" "_m")
1 R  E  `7 h2 ]) n(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error* *error* myerr)
0 b4 \+ k' R0 j/ T+ E(setq oldos (getvar "osmode"))
4 t* H" ^4 X: m6 ~3 S; a8 N(setq oldfill (getvar "fillmode"))
; P8 n" U" i5 j2 \6 c(setvar "osmode" 0)
(setvar "fillmode" 1)
(setvar "cmdecho" 0)
1 D' L$ n0 ]% }$ W(if (not (tblsearch "style" "宋体"))
(command "_.style" "宋体" "宋体" "" "" "" "" "")
)
' N* @' ^1 ?  N) p" y- N* h$ k$ G(setq ss (ssadd))
(while (not pd)
(while (not (progn
(setq gr (grread T 1))
9 S6 V/ s, {; `2 X6 X1 q$ |(if (= (car gr) 5)
/ E6 ?. d; R0 G5 b% W% x. F(setq pt (cadr gr)
  ^9 f/ c5 ]1 A, w/ {2 w' f8 `ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
0 Q( \% p% o9 G" u(car ent)
)
)
) A7 R: Y. t0 H# W8 w$ T  k(setq pd T)
)
))
' \+ G' Z, x! |/ h)
, F4 M( c5 _8 ?2 v/ M! O(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
% p1 @  }$ _. G(progn
0 w0 P, p1 V: K/ e! R' J(if entold (redraw entold 4))
( d/ }! L! x5 l+ g( O: y8 o8 g(if ss (command "_.erase" ss ""))
(redraw ent 3)
* y- Y; r. v' }  H, D(dis ent)
, z2 S: T* x2 J9 M6 N5 v# i) ?(setq entold ent)
& s# ^8 p; i( T. n' }: ?" {)
)
, Y$ J5 h2 q# u( Z)
% B! f3 l* F7 e: M, N(if entold (redraw entold 4))
2 x* x) }5 j$ I( t(if ss (command "_.erase" ss ""))
(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
(setq *error* olderr)
(princ)
( c6 F" J! X, C8 B. Y) [)

十二月

这可以得到任何种类曲线(包括LWPOLYLINE)的总长
(vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
希望对你有帮助

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长