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

A云

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


$ g/ h! W) o8 b8 Y5 ?(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
% R8 y- Q( ^: f8 D                                                  ；；输入一个实数
/ N; o: B, G: X: E! A: }, H8 K
(defun myerr(msg)
4 [! D2 U7 B9 C/ t5 p; Y  G6 r6 D(setq *error* olderr)
(command "_.undo" "_b")
(princ)
)
( h: K- h$ P1 k7 R(defun dxf(ent i)
+ S- C7 i3 e8 p' g: H(if (= (type ent) 'ename)
2 }7 c) j/ D  e1 r( `" |(setq ent (entget ent))
3 n% n! ?2 t% R$ h; |5 r7 v)
3 ~# J9 R" F! Q8 D; C(cdr (assoc i ent))
)
(defun toang(ang i)
(if (= i 1)
* k- [0 I4 u, h9 J4 ?* w( d(* ang (/ 180 pi))
: B& {4 G+ v& z  ?" H5 f6 h(* ang (/ pi 180))
8 N" a- j+ W, H7 @2 w, s" ~)
)
(defun fx(ang)
(cond
. ?7 I: N" K- z+ d; N" l- E((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
  a* X; f2 p0 {- D" \! ^) D3 _. F((>= (+ 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")
(cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)
)
)
# q4 C# \9 U" `)
3 ~1 f* [3 T0 R, |7 r(defun add_text(pt h ang txt style jus)
. g% z; T9 `7 e3 X(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)))
)
; a' E3 }5 Y9 k- i2 B( f2 L+ ^  U)
)
* Z7 ~; J; U( Z; y6 v(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
(setq obj (vlax-ename->vla-object ent))
, D. ?- K# G5 M' @0 I(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
" k$ I, Z5 p6 e* O* d6 a(cond
5 E  l! I7 v: s' U((= name "3DFACE")
- B: t7 i$ u9 k9 E* k) ~(setq lst (list "【三维面】" laynm))
8 c5 W6 r) D- ?3 m4 E6 w)
9 K3 d6 g% p; g8 j( x((= name "3DSOLID")
3 W# Q5 O* `0 {/ Y(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
# r& f0 h& x7 G, i; H" S)
- |9 J7 @* }7 N8 V% s. h  O1 N' J" o((= name "ACAD_PROXY_ENTITY")
  N1 w2 a7 G) h' }- ~(setq lst (list "【代理】" laynm))
2 Q: B( _* d1 G. @, N2 l) ])
6 k5 |% T8 [5 O. `6 V- \/ \((= 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) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
* L( T% p6 J1 f5 F: u6 \# H# Y(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
* d  d. h5 n* o1 z% ]))
)
% q6 A! D8 {+ [$ Y' l1 R) c+ g% E+ p9 }((= name "ATTDEF")
  h' D( n, J' M: l; f: h(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
3 @/ b, z  w$ R(strcat "提示:" (vla-get-PromptString obj))
- _8 M- @9 ?0 q' u4 K(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))
# |; a8 [2 c3 l6 ^6 o5 F( U* t* h, K))
! i, w1 H) |: q) P2 |$ r" _)
" G+ K) I& `  C9 g# S((= name "ATTRIB")
, s, k/ x# M; i9 q(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) "度")
3 e* _- s1 _2 C5 o( H8 A7 x(strcat "文字样式:" (vla-get-StyleName obj))
))
8 i! N3 L- Z7 g# Q* A, s; K)
+ F  N2 t* a  P# w- s/ T((= name "BODY")
5 X/ w6 l& K$ \5 Q" b* z) T/ h(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
+ }0 _( z# `# g0 d3 O5 P. ?)
((= name "CIRCLE")
(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
. o5 H) m- V) t" D& T( r(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
$ ?* R) u: y, N, _! g' G* l2 x))
$ C2 c+ _5 L+ C; [* ^! u)
$ v! a7 Z- o$ K1 C' S((= name "DIMENSION")
(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
6 V2 d4 Y: L* V( m(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
))
+ D: H" u, {" j9 E+ h$ Y)
((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
$ d: s0 w/ ?/ T+ F" a9 ](strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
  B  B& m2 X! B(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
% Z6 O7 @. e" T- z2 a5 p4 @! D! x! O(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
# A# m6 g: k7 d% }# d$ E0 U(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
0 t; g% E, @! _8 E: c6 h))
)
" `- y; \9 p8 X& u1 P: o' z((= name "HATCH")
(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
% L4 u1 ~  D, Z1 ]4 t% z  u  w1 E(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) '("普通" "外部" "忽略")))
! K/ r+ O, k" f- v. P) Q))
)
((= name "IMAGE")
6 e* o- r1 ?; g, O(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
)
((= name "INSERT")
) E, d2 n: p, c8 {% l( s, c(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
7 A+ l! E' i9 ~* e) S' {5 r" g' t(strcat "X比例:" (rtos (dxf ent 41) 2 1))
(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
/ U2 h. _, ~" \, u(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
- ^# F; X# [# w. x  K* D+ k)
((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
))
6 @( U: H* p7 I1 t. ]2 I)
((= name "LINE")
(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
0 @6 h+ H5 ~8 N, H(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
))
)
6 W+ t4 E, M  [$ l2 _7 C((= 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) "不闭合" "闭合"))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")

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

A云

))
)
) G; H2 _: F; b((= name "MLINE")
(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
) h1 m) j" Z( Z* w4 T(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
))
5 K  z0 N. z2 B, })
/ [# I- w8 ~8 d" I9 P/ o, O((= name "MTEXT")
(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
6 q4 r; R5 J! e2 P6 W(strcat "样式:" (vla-get-StyleName obj))
))
)
((or (= name "OLEFRAME") (= name "OLE2FRAME"))
(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "POINT")
(setq lst (list "【点】" laynm))
2 m4 n9 Z1 j8 T; S0 v)
6 k+ b, z& h4 X8 B1 A$ B( ^((= name "POLYLINE")
(setq lst (list "【三维多段线】" laynm))
)
* C% \7 d) B) G1 z- G3 Q((= name "RAY")
5 {/ W6 @  v' t/ T& N7 {(setq lst (list "【射线】" laynm))
)
; ~" Q9 u! O& s" q) {/ z; }$ U((= name "REGION")
! [$ _# c" `7 w(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
6 p& w6 R' k2 c/ Q8 \- p)
((= name "SHAPE")
(setq lst (list "【形】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
/ [& Z+ \7 o3 Y3 m3 b7 E(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
& f) n2 q# L6 k* V(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
)
((= name "SOLID")
(setq lst (list "【实体】" laynm))
)
0 h5 d3 Z8 x0 H+ X((= name "SPLINE")
(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
0 Y7 I; U0 U. V& O) A" ]2 O(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
)
((= 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) "度")
% A5 m2 {3 z) m$ e(strcat "样式:" (vla-get-StyleName obj))
(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
. e+ R% u0 k3 I* h0 U( i3 |"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
- k# Y: _3 ^, R) D3 W)
6 }* u5 {( O+ y+ L+ G9 R((= name "TOLERANCE")
(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
2 g6 O/ S  P& q. E. _* P' Z* T(strcat "文字样式:" (vla-get-TextStyle obj))
/ B+ t6 h2 h- D* E0 y& @# i9 V(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
  [5 j2 t, \( l' q4 j, \" m))
4 `! \, H) X$ R9 q9 L9 ?6 U)
) {: u; }7 u% \& y. W& c( w6 s" v((= name "TRACE")
(setq lst (list "【宽线】" laynm))
)
( y; c" J6 n9 P; n# e  B: X((= name "VERTEX")
(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
% F, w4 C1 U1 S(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
(strcat "凸度:" (rtos (dxf ent 42) 2 1))
))
3 c# T: q2 L# V6 [$ `) `2 A)
((= name "XLINE")
(setq lst (list "【构造线】" laynm))
)
" S5 w( B7 |6 @4 C6 z$ k3 W(T
(setq lst (list "【未知对象】" laynm))
)
; R: a! C+ n1 P5 y% C8 P)
(setq ss (ssadd) h (/ (getvar "viewsize") 50))
(setq ang (fx (angle (getvar "viewctr") pt)))
3 B! t/ u& l0 q(setq n (* 1.4 (1+ (/ (apply 'max (mapcar 'strlen lst)) 2.0))))
# Y+ R" a0 R  ?8 T(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)
(setq pt (polar pt (/ pi 2) (* 0.4 h)))
1 R- J& t+ h  ?# d8 Q(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
)
(setq n -1)
) x  [% {) d* Q' p# J(repeat (length lst)
* m' c  G" v# U4 Q( W(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
6 ?0 J- @- S) f4 t# Y4 a( o* m)
9 ?' M" u/ j- ^6 E4 _, p)
9 _6 F6 n- k4 r. w. P* ]8 Q' Q$ A(vl-load-com)
(command "_.undo" "_m")
(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error* *error* myerr)
(setq oldos (getvar "osmode"))
(setq oldfill (getvar "fillmode"))
2 s3 v1 o6 S4 d" a(setvar "osmode" 0)
(setvar "fillmode" 1)
(setvar "cmdecho" 0)
(if (not (tblsearch "style" "宋体"))
(command "_.style" "宋体" "宋体" "" "" "" "" "")
. X$ ^, `( |- E, n6 W)
+ q6 m) W+ O3 V1 M3 E(setq ss (ssadd))
9 t: K' L1 i4 b/ \(while (not pd)
(while (not (progn
4 d3 X9 m+ m3 l) ]6 ~(setq gr (grread T 1))
8 N" ~: P/ x4 k' M/ I% \6 W(if (= (car gr) 5)
0 H5 ~& K9 Z# S  W6 q) a(setq pt (cadr gr)
ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
4 i5 s+ v8 R+ o* ~# x. ](car ent)
)
)
(setq pd T)
)
))
)
(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
( I! Y* V- F' U0 Z(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
9 B/ ?+ I- R- k7 t(redraw ent 3)
/ u; d2 h5 F( A& R/ U(dis ent)
5 f# N6 q' H5 C. u(setq entold ent)
6 E* ?# H7 A* e# v/ J% t)
)
+ h" [5 i: F" v, m# D. t3 X% e)
3 f2 E6 x+ H3 K" X4 A% {* I# c(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
(setvar "osmode" oldos)
' |) {7 j) c. [* H0 m(setvar "fillmode" oldfill)
( m) A. @  m6 e& ^. |0 f5 G(setq *error* olderr)
5 @; E/ V) X: w( S(princ)
)

十二月

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

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长