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

A云

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


7 k/ ]" {. a* f' P
& Y; g+ n9 N- ?7 V  p(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
; _, n  d' R( W8 B9 p9 M# s0 M                                                  ；；输入一个实数

* U/ G+ s, e, g5 ^(defun myerr(msg)
( f( y4 G8 Q) x6 o  T$ }1 B7 f& \(setq *error* olderr)
6 v2 `, E% V  d1 f(command "_.undo" "_b")
0 a$ C) F& o; `. I. N! A(princ)
)
4 R( X' w7 G  ~7 ?  [(defun dxf(ent i)
(if (= (type ent) 'ename)
(setq ent (entget ent))
)
2 y- p/ F3 e1 d" ](cdr (assoc i ent))
)
, M1 j1 z; \3 l% E8 C+ }; M(defun toang(ang i)
$ q( ]. o2 }* B6 Y- m, ~(if (= i 1)
" \' t6 X& ]' N, C(* ang (/ 180 pi))
(* ang (/ pi 180))
) w4 V( [% D2 a' ^5 b* _)
4 Q- s5 a0 `; d  h)
, l1 c9 N0 Q2 k" i* c$ m, |(defun fx(ang)
  L1 W. o4 L* k(cond
9 ^; c! Y. r6 ]' Z( J, z8 t9 ~((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
- S9 {6 d2 r8 U! @! x8 R- V" I((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
)
)
) e% X  A8 {3 M* D! ?% _(defun add_solid(p1 p2 p3 p4)
" w3 S- t* t$ {9 }8 l(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)
)
)
)
* V0 C5 {# z# w$ Z) S4 k( |$ u& K(defun add_text(pt h ang txt style jus)
" l# B& v. d0 |  ^(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)
2 C# i) i& `6 G6 ~/ K9 R6 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)))
6 w/ W% }7 v7 b' d& K)
4 p1 H* [0 T) k! a" x)
+ e' p+ s1 z" j! {4 p)
0 N2 n4 V8 k3 X6 y(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
(setq obj (vlax-ename->vla-object ent))
. `, I, h) R9 l5 i- i7 e7 s6 A(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
, J2 U$ {/ G& k(cond
! Z# ?: |" f; v$ y, Z((= name "3DFACE")
(setq lst (list "【三维面】" laynm))
)
; b& m$ P3 G' j+ K! I((= name "3DSOLID")
(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "ACAD_PROXY_ENTITY")
9 X$ T$ C! d9 w  R' i+ b* R(setq lst (list "【代理】" laynm))
- `2 W& Z) S) S/ o* N0 \& @)
, Y* \5 D7 G: C/ p4 o* u. J((= name "ARC")
5 Y% P! ~/ t# ]; y4 m5 t(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
8 T& `/ t( Q, Q) v' E8 x3 H+ z(strcat "圆心角:" (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) "度")
4 v. M6 B! p- f0 w+ L(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
' ?0 r4 j; |8 a* r" J. p" {(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
- H" e/ t& v4 K6 |# N(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
: U: L7 K, ~' C3 y/ s1 |4 E))
)
((= name "ATTDEF")
(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
/ i8 Q4 h$ L! k8 Y(strcat "提示:" (vla-get-PromptString obj))
  C! w8 l. c& d) L+ `(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
4 G5 i1 Q4 u6 ^' i(strcat "文字样式:" (vla-get-StyleName obj))
# @+ |0 @5 x, f& F))
)
) X$ a$ }. ~9 C5 v: T0 c" P1 M' h((= name "ATTRIB")
(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
4 Y( ?; G# L" M$ e(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
))
" }* j9 Y4 U6 O! {- X)
((= name "BODY")
& t: q: n0 \8 @0 m& S(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "CIRCLE")
(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㎡")
))
( e3 ^8 i0 u7 H)
" J& v+ C& D, u  w% v((= name "DIMENSION")
(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
3 ]0 w) S; e1 F' w(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
" X- h3 F) u8 n6 D5 W(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
))
1 Z  S$ U: \) G) `1 @)
((= name "ELLIPSE")
( i6 t! X1 Z0 x* s(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
+ g4 h/ R' q# P9 [; Q(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
6 j6 }* n: d" }9 y0 B4 s- f% T+ J1 U(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
' {7 F2 Y* o2 K% b; D( ~2 o: A))
5 M$ p; n! O8 k4 k! X; u2 M9 Z' y8 X8 S)
; A4 Y1 |( ]8 u  O  ]((= name "HATCH")
(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
3 H* q, c! }# N(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) '("普通" "外部" "忽略")))
))
1 W3 q, W0 I( A5 }- j)
) x1 i2 M6 |' j  O((= name "IMAGE")
' v, E  }. h( M(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
)
: m5 r/ N8 a# a# I9 K+ R8 C3 `((= name "INSERT")
4 ~: R! i: ?9 x5 r' E9 [, E9 Y8 q(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
(strcat "X比例:" (rtos (dxf ent 41) 2 1))
(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
4 E6 R4 H1 d5 F6 _- {8 N6 O2 u0 L(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
/ R7 x% X' v: b(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
! S: n$ H+ d5 z& v$ T+ Q6 i)
) O$ v: T. n: f6 e# T3 ]4 P5 O% [((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
/ _- n1 e" B7 |3 h  d  _) o(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
))
)
((= name "LINE")
(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
% j$ L7 B* L  o' q; t1 o" i3 H(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
4 \5 L, Y/ u! X4 u' ]' ?) R7 j))
)
/ h5 P; F: M& b) f((= name "LWPOLYLINE")
! b. h4 P4 t( T2 `7 K$ f(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
2 f5 i1 m% n) Q5 f, I4 s(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")

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

A云

))
" W% W& I  \' C5 B/ M- P)
((= name "MLINE")
4 q. @9 k9 i; q* x(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
9 O' G9 l6 ]! b% E. I/ i(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
))
) N! N- H1 @5 B0 ^2 q2 t)
((= name "MTEXT")
(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))
3 |* v' D" A# p. }+ i6 \))
* s/ A( V- Z9 I- {# e5 D9 R) \)
((or (= name "OLEFRAME") (= name "OLE2FRAME"))
! Z! y2 z0 U! C(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "POINT")
(setq lst (list "【点】" laynm))
)
((= name "POLYLINE")
(setq lst (list "【三维多段线】" laynm))
)
((= name "RAY")
(setq lst (list "【射线】" laynm))
)
((= name "REGION")
8 l* v( V6 \5 ~(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
$ F0 l5 m3 [' N) J* y1 z- V3 r* d((= name "SHAPE")
/ x8 b# f  |& p+ l+ P$ }(setq lst (list "【形】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
0 D' g; _2 c1 u9 a5 ~" V! r(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
)
. B( K9 j: G; y/ S2 W0 [((= name "SOLID")
  ?& Y5 O7 ]: z& I% |" M(setq lst (list "【实体】" laynm))
2 s7 e( c9 D3 K# M8 R% W)
2 V& e" K0 E/ }( ?((= name "SPLINE")
(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
. ?& v! Y% [& i7 Y  n(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
3 j1 X7 b( Q1 X' `1 s" x9 @))
)
, d9 i4 C; d( L& |((= name "TEXT")
(setq lst (list "【文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
7 [" D9 g5 L* Z% W7 s(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "样式:" (vla-get-StyleName obj))
(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
4 \+ z' X5 a- I! F# m5 p"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
- E# ?8 _3 ^! C)
((= name "TOLERANCE")
/ m4 c# `  @, g( y3 b# r5 N' U9 C(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
" I1 x" e7 x5 h! D5 t% @: Z(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
))
)
((= name "TRACE")
(setq lst (list "【宽线】" laynm))
)
( a% I: Q9 l7 x3 H7 g$ t((= name "VERTEX")
- H5 z7 `6 J2 W& g(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
% G& w) D* ~" i3 X(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
3 }0 z3 O' F" `& L6 X# D: ?) z(strcat "凸度:" (rtos (dxf ent 42) 2 1))
% a" {! M7 [9 h+ ^4 r& Y2 H8 Z+ ]))
1 E. V6 g* p2 g6 y0 W0 l: M)
# G+ ~0 b6 d2 p6 [5 C" T((= name "XLINE")
(setq lst (list "【构造线】" laynm))
)
8 E8 T9 e2 ^1 u3 E6 [# u(T
(setq lst (list "【未知对象】" laynm))
4 O5 y- r1 J7 U7 I& N) d' K6 Q- g1 @4 w)
)
(setq ss (ssadd) h (/ (getvar "viewsize") 50))
$ W. ^0 Z- O- O9 ^; O  R- m(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)))
; N8 M4 B( J5 L- X% g' b(if (= (caddr ang) 0)
8 P* j! v* p( ^1 X(setq pt (polar pt (/ pi 2) (* 0.4 h)))
' _# z- h* a- d4 D0 I! ?  L(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
)
# y0 |9 ~; a" k) a/ P(setq n -1)
4 ^4 q8 e7 P4 x(repeat (length lst)
# \) u' g+ p, c+ M/ Z- T! r. ^(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
, e% m3 S/ E7 P* j)
6 R/ W4 }% n" b4 Y)
( Z+ H  R$ J0 K+ U- n5 {, S  e(vl-load-com)
(command "_.undo" "_m")
(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error* *error* myerr)
( N3 W: Q6 T& S" B; z9 E(setq oldos (getvar "osmode"))
(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
+ x* @% z; u6 k(setvar "fillmode" 1)
(setvar "cmdecho" 0)
5 I  r0 T4 }' b0 s4 [: b+ o(if (not (tblsearch "style" "宋体"))
6 O1 Z9 r2 D1 e6 [(command "_.style" "宋体" "宋体" "" "" "" "" "")
)
# T1 S: P( f, _; h9 L(setq ss (ssadd))
+ t  L2 ^4 r7 p4 ^3 y, E(while (not pd)
1 u$ F# {8 ]3 A5 |2 @7 l: z(while (not (progn
; Y& G; V$ ]# h  s(setq gr (grread T 1))
(if (= (car gr) 5)
(setq pt (cadr gr)
ent (nentselp pt)
+ ^0 t" J$ X8 [  _- S! C( V! @ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
5 n1 e8 V! T' d(car ent)
)
. f/ v6 D1 l3 v; ~; r2 C)
. K9 I. n7 Z# [. h7 r- Q, r+ T(setq pd T)
)
))
)
(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
3 h& g. s/ k: U9 h  @1 c6 D(if entold (redraw entold 4))
3 P6 I% M3 \# v9 j9 q(if ss (command "_.erase" ss ""))
$ t" ]& @9 \6 @/ n: t+ t(redraw ent 3)
(dis ent)
9 S. I% v# Z7 D, f(setq entold ent)
; n8 E* ^' R; o; T+ L& Q)
)
1 U3 E# @7 K* g9 Q0 T# {3 G)
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
5 T  y! _4 ^" O! C& d6 u% S8 `(setq *error* olderr)
(princ)
: y) \* K3 W/ i" t, b)

十二月

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

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长