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

A云

这是个动态查询的程序，想在里面加上一个可以查闭合多段线周长的功能，显示出周长的长度，还显示一个周长乘以可以输入的一个数的等值，这样方便用来查线割的价钱，有哪位高手可以加上去的请帮帮忙，谢谢了
" ]/ s: {8 A5 ^3 p
5 t! q) K+ L7 p
5 d; i6 D8 m4 }* l! a* b$ C
+ |% C; d. e7 f+ C! \% Q(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
                                                  ；；输入一个实数
( M$ i0 F$ p' n( x$ _
(defun myerr(msg)
(setq *error* olderr)
0 ?5 c; ?: \6 Y  f) t  A5 K9 y(command "_.undo" "_b")
% W7 S+ c# V4 b(princ)
)
' c/ }2 X# r& m* `(defun dxf(ent i)
(if (= (type ent) 'ename)
(setq ent (entget ent))
)
" y+ q4 V6 r' O1 o: J(cdr (assoc i ent))
)
(defun toang(ang i)
+ c: i) ^2 k4 W(if (= i 1)
- i& `8 l: B3 k! c% \# `& p$ }+ D4 e(* ang (/ 180 pi))
" A( [% ~5 A. C. @9 Y* z9 [(* ang (/ pi 180))
) ^1 c4 p# z1 ~2 B  K)
( W' s/ l7 _3 S9 U" u  z)
# V$ x5 K9 J1 z% y( q$ Y(defun fx(ang)
(cond
((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
. U% k: |) K' q' K  N0 m((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
3 _4 r$ T; K! X6 @# g2 {((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
3 L! w1 F8 @# j9 d7 z)
)
  K. z0 l3 X5 ]) r(defun add_solid(p1 p2 p3 p4)
(entmakex (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 62 1) (cons 100 "AcDbTrace")
. L1 @" C/ c* p(cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)
! y- I+ a& w6 l$ {$ K5 b2 \)
)
)
(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)
, E" P* e% |8 K7 S1 L1 q/ {. k(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)))
1 L- D. a# z& M) U5 r. i)
; w% e" I. A- x' W$ l)
)
(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
(setq obj (vlax-ename->vla-object ent))
. D: @! z; R0 q4 [4 |2 o# S2 R( h9 a(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
(cond
((= name "3DFACE")
(setq lst (list "【三维面】" laynm))
7 {3 s8 M% o2 O)
((= name "3DSOLID")
9 P+ n7 G* @7 ]5 l  P  `1 J(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
9 v1 o0 b. z1 O2 m/ o% |)
# _) Z4 W9 c( \, w! X((= name "ACAD_PROXY_ENTITY")
) [* o0 A* m! C6 W' F' R- ~(setq lst (list "【代理】" laynm))
)
((= 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) "度")
; Y) X7 X0 r/ H5 H6 i: [$ L; d(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
+ \8 r% j$ K( e0 G3 h(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
))
)
((= name "ATTDEF")
(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "提示:" (vla-get-PromptString obj))
(strcat "缺省值:" (vla-get-TextString obj))
0 U/ q" e; R' ~* A1 z% R(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
+ d8 D& j' c( s4 i% u& v$ K- {, d(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
: ^$ ~9 x: N, i  r))
)
  B1 q( N) t6 b1 o/ `((= name "ATTRIB")
$ u$ O3 o! D: k$ g$ I" r(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
$ ^0 d. B) U+ x2 t+ w3 b(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
3 R- g' H8 {4 p! e* d* T(strcat "文字样式:" (vla-get-StyleName obj))
))
)
- W# e# o" ]& R/ n((= name "BODY")
(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
6 p) D) b5 L( M* @/ n6 B((= name "CIRCLE")
(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
0 i* l. d' W6 X) N) ^2 B(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
# Z* i2 k+ Q' _( h$ k9 E2 v) a- V)
((= name "DIMENSION")
(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
: C4 ]6 O) p  z" Q, G1 R. _(strcat "文字样式:" (vla-get-TextStyle obj))
8 E. x* p, O2 z2 Y% H(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
$ v5 t* Y0 A9 a(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
))
)
((= name "ELLIPSE")
% ^/ U. ^8 E% B, f" Y) {(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
4 \$ Y4 |- O+ I8 L3 M/ H8 m(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
" o7 T3 i/ v3 J5 N' z  c' f(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
; l( b  E& {+ }+ F* e9 \1 p  |(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
)
" ?3 U$ N0 ^4 H* X((= name "HATCH")
+ `4 h7 s9 a3 I% B+ P(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
(strcat "角度:" (rtos (toang (vla-get-PatternAngle obj) 1) 2 1))
+ v* s# j* L( ](strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
(strcat "关联:" (if (= (vla-get-AssociativeHatch obj) :vlax-false) "关闭" "打开"))
(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
0 t9 _9 B$ ^- x, D- q# S5 s))
)
2 e# m% E6 s5 M% r5 f3 O((= name "IMAGE")
  H7 ]5 y6 l8 A9 n. ](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))
, H0 [8 V' E* |! M(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) "度")
))
1 ?& a9 `6 X# S+ c4 e8 y5 \/ ~)
((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
))
; x' r2 v6 s4 i0 p" U, O)
' y& g7 Q; }6 ]0 R, I9 U((= name "LINE")
4 [/ q9 u( A9 O3 a3 ?(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
! d  q) e( v- m- g8 l8 A(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
))
)
. {& B' `" ^% v8 F. V) n((= name "LWPOLYLINE")
$ k$ ]9 z' g% z# U& W(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
" Z; z2 O' e; m( F9 H1 z8 c(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
1 f* ^9 Z7 i0 V8 n  H
                                                           ;;加上一个可以查闭合多段线周长的功能,显示
. _5 c0 D! W) E) m. s0 i5 @                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
  Z6 |9 _0 X% r; r* v/ x8 Q)
((= name "MLINE")
) Q# Z" E$ a3 o' e, ?(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
$ n2 u; e9 @( t" c& t  S(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
))
( S: G9 r7 P* @9 j, S- d% P)
) Z# t! f* v: R+ L: M((= name "MTEXT")
(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
+ ]" O5 `9 n1 D(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "样式:" (vla-get-StyleName obj))
: L3 Y3 g" ?" I2 ^  m; G! w))
)
((or (= name "OLEFRAME") (= name "OLE2FRAME"))
(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
$ X5 Y* H9 w: E, l)
((= name "POINT")
" K& |* Q% {' b+ S8 ^& q2 u! \(setq lst (list "【点】" laynm))
  r; V; Z- u* ~  g)
((= name "POLYLINE")
! `$ a" n! ~" B: G& R1 M9 \# W(setq lst (list "【三维多段线】" laynm))
& [  v! f% E- P- z' t, S/ u)
6 L3 Y/ C+ S( x) |8 f! s((= name "RAY")
(setq lst (list "【射线】" laynm))
2 D3 Q2 N, W% n* s4 j. q! a( e)
((= name "REGION")
(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
, U* M/ a, A$ v((= name "SHAPE")
(setq lst (list "【形】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
) N0 K3 i1 b2 G3 ]% F' O- A(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
. G% s$ [% q7 V- Y)
((= name "SOLID")
8 D6 l/ ~& w4 R6 W) ?6 c" N! J(setq lst (list "【实体】" laynm))
)
((= name "SPLINE")
) ^3 n8 S0 k5 }; a# l(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
# x+ Q$ }; ^. |# l" }(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
+ O  o6 |% w" T(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
)
. E5 `" j# g& I2 }3 F((= name "TEXT")
(setq lst (list "【文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
' _/ x- A1 J! `! R7 |" k0 ]5 A# X(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
. A6 k4 F2 z! O. c4 y4 c/ M3 x(strcat "样式:" (vla-get-StyleName obj))
6 }  x( ~7 C) I0 s; R: b- i(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
* n' \7 n+ K- j)
' ~. e7 v% u& [  O((= name "TOLERANCE")
4 i, C' _$ C( D(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
' M4 m  i  {& N0 K9 K/ Q: b(strcat "文字样式:" (vla-get-TextStyle obj))
* v& D+ D* C- C( |4 {(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
))
! G! \: `- Z. Y+ x1 P* d: ^)
((= name "TRACE")
/ R% I4 U& N9 I$ a; q(setq lst (list "【宽线】" laynm))
)
((= name "VERTEX")
5 P) a& x+ m2 B& v& ](setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
  y; [  r$ t& h$ O% K9 M! y(strcat "凸度:" (rtos (dxf ent 42) 2 1))
8 L' w' M% p7 {: b))
)
((= name "XLINE")
7 D5 n9 G9 ]# L! g4 q. u. y(setq lst (list "【构造线】" laynm))
)
# E  ]! _& c3 `- m  u; J(T
(setq lst (list "【未知对象】" laynm))
)
)
* h& J9 m& ?. k! ~(setq ss (ssadd) h (/ (getvar "viewsize") 50))
( D' L$ B- K. J/ D+ t! O4 c. ](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)))
(if (= (caddr ang) 0)
(setq pt (polar pt (/ pi 2) (* 0.4 h)))
3 L/ r; c; ?9 V% X(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
)
(setq n -1)
1 J: U4 T0 E' E3 P3 ?6 y(repeat (length lst)
; P6 ^# t" L2 {(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
& G5 `: o$ B/ j8 j9 ~' A6 s1 J)
)
- n; N2 a, w; f9 {+ w: f) W(vl-load-com)
' b/ [; m+ [$ \(command "_.undo" "_m")
(prompt "\n***移动鼠标掠过对象查看信息！***")
, Z( a7 Y6 Q& \! ^0 I3 @# \" `0 l9 Q(setq olderr *error* *error* myerr)
(setq oldos (getvar "osmode"))
1 ]5 W6 F, i5 q: X) M! Y( i/ T3 s(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
(setvar "fillmode" 1)
0 E+ y. A6 @- r, s8 {3 S(setvar "cmdecho" 0)
(if (not (tblsearch "style" "宋体"))
2 c' ]4 n+ g7 h; F(command "_.style" "宋体" "宋体" "" "" "" "" "")
)
1 g; O' M7 z8 X. e(setq ss (ssadd))
: e8 I( p. Y$ ]' x9 I1 b1 |- ~3 K(while (not pd)
(while (not (progn
# m4 T: a2 v2 e4 {( o; d(setq gr (grread T 1))
(if (= (car gr) 5)
1 i, T9 b8 E$ w) R8 `6 M(setq pt (cadr gr)
ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
$ N5 q3 X+ O" j/ E; ]8 I6 s(car ent)
7 m9 {* D  d% U  M, B7 o* t% V; j)
& S; [/ u8 i8 U5 _! s* @* ~( N)
(setq pd T)
)
))
)
* z8 c7 w! Z8 p' X/ @5 m# \(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
+ m9 h" ^2 ]* X) K; B7 H(progn
5 l: \! K0 E! A  R  X(if entold (redraw entold 4))
9 b; C. U) w# ?9 [: c* v2 V/ d- @! F(if ss (command "_.erase" ss ""))
(redraw ent 3)
1 p; U4 n* P# C! s(dis ent)
(setq entold ent)
% j; R  d: N. N)
)
! c) R. m; n7 i6 p* I)
(if entold (redraw entold 4))
( C5 Z! ^1 y; L8 g3 K( c(if ss (command "_.erase" ss ""))
(setvar "osmode" oldos)
( u6 f2 H" P" }5 W5 Z! g8 T(setvar "fillmode" oldfill)
(setq *error* olderr)
(princ)
( i, M! t7 e! b1 X)

十二月

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

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长