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

A云

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

0 Q" J! X3 M- e0 t0 P

(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
; a) r+ A- w* `$ i9 m. T: f                                                  ；；输入一个实数
! N1 G  b/ \6 P+ ^9 ~: a/ Q1 b) I; C/ I
0 [( G% Y' q* O3 j0 [(defun myerr(msg)
0 L: K; ?; O6 S0 y, l. ^# {& y(setq *error* olderr)
/ G6 i2 {/ Y+ l' ^3 ](command "_.undo" "_b")
(princ)
)
(defun dxf(ent i)
8 ]% J* p4 m) u' a, X4 E(if (= (type ent) 'ename)
0 h, A+ G# G  s(setq ent (entget ent))
)
(cdr (assoc i ent))
* y& u# q6 W" ~+ U5 j)
(defun toang(ang i)
  G( |* E1 _; m* A# J' T8 A(if (= i 1)
(* ang (/ 180 pi))
(* ang (/ pi 180))
)
3 V2 |4 S+ z1 j8 Q- m)
5 z+ u  ?6 ?* ?(defun fx(ang)
- i2 k7 o, D/ W(cond
((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
0 Q- s5 `2 c& x& j/ M# _! ]((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
; m5 B4 R, q; S' n: |: v$ Y4 o((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
/ {# R0 l0 t7 e1 N4 D)
)
% E: ^% F# k: F2 r(defun add_solid(p1 p2 p3 p4)
(entmakex (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 62 1) (cons 100 "AcDbTrace")
3 x6 i% N. B9 T" {! O2 ]( }- r% ]" w(cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)
1 s) N1 ~* U" E1 U# l$ K- v)
" l4 U' ~# [/ s7 x2 t1 A+ `2 O)
# P7 j# @( M8 t2 i)
! S8 _, a1 G. x" G4 k' y0 U(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)
1 n3 r6 U. ?. M! Z/ n(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)))
)
)
7 N# s* \" w. O/ })
0 W3 h: y& d( X: {(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))
, \. A+ @/ Z& I! j, a2 h2 i0 |(cond
((= name "3DFACE")
0 z* s" d9 q+ P$ v0 A(setq lst (list "【三维面】" laynm))
; V0 _; x5 {6 T- B; Q)
((= name "3DSOLID")
(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
/ M6 r/ V! F9 Z0 t7 ^4 L! f& o  K)
((= name "ACAD_PROXY_ENTITY")
(setq lst (list "【代理】" laynm))
( s  f1 q# h- D& M6 S)
/ w4 U" S0 _: E2 ~  u4 F9 \0 p((= name "ARC")
(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "圆心角:" (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) "度")
! F; v+ h1 R# @: K0 r! T(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
6 F  _7 {( ^+ l# L( S( ^  b(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
  O, u8 B2 l+ P7 R. o3 z1 l1 E(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
  ?  R+ B! S+ J" w5 K, J, S1 l7 M. b))
)
((= name "ATTDEF")
4 p& K' k6 P4 b( {8 V% L1 w* }(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
& H# t1 k3 N/ V( l9 D(strcat "提示:" (vla-get-PromptString obj))
# }5 @, p8 r" A: K% P1 ^( r9 G(strcat "缺省值:" (vla-get-TextString obj))
% B! w0 W) _: F/ U, z+ n(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
% z: k# g3 I4 G(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
" a4 q/ y& ~$ ^2 N" J; N(strcat "文字样式:" (vla-get-StyleName obj))
" A0 O1 w* M; f* Z' ]+ v" Z! X  }! T2 i))
& c5 m" d' U3 C+ t6 |5 J" `$ s1 B)
/ m6 d- b1 l. D6 A1 m((= name "ATTRIB")
(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
6 P* a3 S" I) z3 u/ w0 ~. t(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))
3 [. J* O: L4 r. E, b2 m" {))
)
+ L) [% [: l  L3 Y((= name "BODY")
& o. t) v& q8 m9 T' y(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
* [. N9 e+ W( ?; x$ Z)
((= name "CIRCLE")
$ y6 L2 V0 @2 f: \( @1 w5 ?(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
, g  d1 }5 X; b" Z1 G(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
( |  b8 ]8 ^5 R))
9 K% [" `3 K1 F( s3 W; O" A* {- M)
((= name "DIMENSION")
(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
$ d! {. L3 o+ a* }6 N(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
0 W, a& I6 M! @6 _9 C9 v))
3 v  p4 k. B  d& g3 v8 a)
& K4 l8 }2 t8 [+ T((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
  z7 P% F1 i, {) H' ?0 R  J(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㎡")
))
0 p" Z9 t* U  D% `% `)
/ Q; S/ W  g/ O# x9 W((= name "HATCH")
(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
(strcat "角度:" (rtos (toang (vla-get-PatternAngle obj) 1) 2 1))
(strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
(strcat "关联:" (if (= (vla-get-AssociativeHatch obj) :vlax-false) "关闭" "打开"))
(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
))
* K4 b. n' h" `& n/ [: d4 P)
((= name "IMAGE")
% C# y  D. U( o$ t# |(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
3 u+ ~5 T  X  a& H)
5 Z, @6 L% V0 |+ ?7 k((= name "INSERT")
(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))
( |  C9 E/ O* U3 T(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
( @& z% L& R6 K)
% T, h" [- G. y" z& f((= name "LEADER")
1 X1 n% Z; n3 q! L(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
))
9 m& `, Y) _+ c)
((= name "LINE")
9 |" j2 S. K* l3 K  W- s3 G(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
$ U. Q1 |+ p& M2 e3 K(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
))
)
3 g' t" M0 W8 k1 D((= name "LWPOLYLINE")
4 c% f( B+ I2 u" _8 F" D' Y9 o- k(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
  _+ v) |4 @! m8 V3 N8 {(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
, c! ^- q; t& N$ W# u(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
( f  L4 u8 n3 _
                                                           ;;加上一个可以查闭合多段线周长的功能,显示
                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
)
) Z# ~7 b& t5 n: Y* s" B2 N4 ?((= name "MLINE")
(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
0 G) S' j% P5 A8 J( d(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
3 ?& m+ O+ w+ j6 C(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
2 [1 M: K/ q* \+ m$ S) j( p$ d; ]))
)
- E- N4 j. Q% t& ^# ], [((= name "MTEXT")
6 M$ ^; ~4 L' E(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "样式:" (vla-get-StyleName obj))
( g+ s; Q4 \' f. d0 Q' \! H+ C: A))
8 _) C# r3 f$ z% B/ I7 ?, W$ x)
((or (= name "OLEFRAME") (= name "OLE2FRAME"))
(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
$ ]) k+ O0 V: V/ x8 A)
((= name "POINT")
; m  O. I, S( ~6 e9 w4 E(setq lst (list "【点】" laynm))
0 q; Z; p& w" a1 v6 M8 E)
2 q8 r$ E- g; L((= name "POLYLINE")
* ~) T$ @! N5 {, E/ I(setq lst (list "【三维多段线】" laynm))
' w3 J0 V9 ]: M2 f& L* m: b9 Z)
((= name "RAY")
% l2 _, i- s5 k& v) c; [2 e(setq lst (list "【射线】" laynm))
)
2 e- S7 K3 Z( ?/ q. \8 U6 l1 K: H((= name "REGION")
(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
) J+ K6 {/ X( Y6 G  @)
((= name "SHAPE")
5 G& N* j% I5 i, H) c) }(setq lst (list "【形】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
, r7 u+ U* @' k(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
1 ~0 J# z/ s3 f: `5 o  e" j- {))
8 V& i  k: N2 w2 l)
((= name "SOLID")
(setq lst (list "【实体】" laynm))
" W* @4 }1 q$ e4 M)
: S/ G3 G. H6 w$ r; u( F((= name "SPLINE")
* w9 h; S8 M6 V" b: ^(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
) g. l2 y( f3 S% M(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
+ O3 r; r2 c3 c( y0 j! B6 X)
((= name "TEXT")
(setq lst (list "【文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
/ `! \( Z" ]9 @& z9 E: t2 i: B(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
4 N  @& }: @4 g2 a: Q(strcat "样式:" (vla-get-StyleName obj))
(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
# q) N, F' [8 t# m)
((= name "TOLERANCE")
( H  u4 ?. l9 A6 K* c0 y5 r/ Q7 d, P(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
$ @/ _* r$ R# C- g2 B(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
))
* K1 y! H6 x2 @" `  p)
((= name "TRACE")
(setq lst (list "【宽线】" laynm))
)
((= name "VERTEX")
3 g. ^( p0 @0 J3 R(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
0 D6 R% l5 D: j% T% M) ^(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
7 f. C) C; v+ P- N) U- }. x. Z(strcat "凸度:" (rtos (dxf ent 42) 2 1))
))
)
4 S) t$ ?7 {" ^& X7 `# S0 Y. K((= name "XLINE")
(setq lst (list "【构造线】" laynm))
)
(T
(setq lst (list "【未知对象】" laynm))
)
)
(setq ss (ssadd) h (/ (getvar "viewsize") 50))
6 A6 [& i  e( O7 t, L; h(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)
(setq pt (polar pt (car ang) (/ (* n h) 2)))
" y/ P; g/ ~5 L: z(if (= (caddr ang) 0)
(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)
(repeat (length lst)
: c3 A6 W2 ]& Y0 b(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
)
: a5 z- B% v! _1 T7 f8 [. O' [)
(vl-load-com)
(command "_.undo" "_m")
2 v2 `7 \1 u6 ~% O7 G(prompt "\n***移动鼠标掠过对象查看信息！***")
, p. R& M) U( P% j! a. H(setq olderr *error* *error* myerr)
( C/ [+ ]+ i9 l, J) \' A(setq oldos (getvar "osmode"))
& b# U7 H6 u  b+ m(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
(setvar "fillmode" 1)
(setvar "cmdecho" 0)
3 b+ [, {$ `3 t: a' `  D(if (not (tblsearch "style" "宋体"))
(command "_.style" "宋体" "宋体" "" "" "" "" "")
' p3 D  s3 |, I+ l) _' m1 d)
(setq ss (ssadd))
(while (not pd)
(while (not (progn
3 O5 c# ]) J# P2 p+ d' X6 z  L' _(setq gr (grread T 1))
(if (= (car gr) 5)
3 G( h! y+ {# ]7 d* R(setq pt (cadr gr)
' |* W3 [' V0 Y2 X# Hent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
: V, A) E; {7 G2 a) X(last (last ent))
; P8 Z% ]8 w& C, z5 y3 j(car ent)
# }  \0 _' ?7 o9 q' [2 s& a1 F1 x, m)
)
(setq pd T)
' i3 p3 T+ p! w)
))
)
(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
* z( G4 M! J2 |: E(progn
(if entold (redraw entold 4))
9 e7 i+ b2 _: B; J- j1 `( V(if ss (command "_.erase" ss ""))
5 X$ y0 ~9 W* L0 o(redraw ent 3)
(dis ent)
3 C, ?' a# u7 q; \(setq entold ent)
- d% Z( v+ t5 Y  }- j- W, j% C)
)
7 W% b& x& C: B* r: ^1 E1 F)
(if entold (redraw entold 4))
+ ?, j; `" h; u4 l2 j% m(if ss (command "_.erase" ss ""))
; }4 f& m! {3 P(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
(setq *error* olderr)
7 T! m8 A: E2 M(princ)
+ Q6 @! V' {, r  b+ y% [)

十二月

这可以得到任何种类曲线(包括LWPOLYLINE)的总长
, D8 G* \9 ~0 r8 \, t! O(vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
希望对你有帮助

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长