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

A云

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

! u+ l  o4 V, {) l" Z# Y9 `! Q
  c, ~7 e1 y0 m7 ?(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
                                                  ；；输入一个实数

/ M) L1 M' g4 e* d" u5 ~) e% s" B: C(defun myerr(msg)
* ?  K5 n% {* a+ u6 ^" E' ~7 N(setq *error* olderr)
$ p" h/ Q0 w( G(command "_.undo" "_b")
(princ)
4 S* J  O6 f' ^)
2 x" c6 {" f7 j8 p1 n  c(defun dxf(ent i)
* ]% q) _. v' j9 i& V5 n! d(if (= (type ent) 'ename)
7 _5 m) w7 ?! W3 A+ R& q  d8 V. ^(setq ent (entget ent))
4 f6 n- o, u, m  Z: [: u)
$ S6 ?: w9 d1 m/ p(cdr (assoc i ent))
)
(defun toang(ang i)
+ y( M* c8 a0 Q4 O2 E" J4 s3 z(if (= i 1)
(* ang (/ 180 pi))
/ H0 I$ L1 C' x$ p, m(* ang (/ pi 180))
8 A/ L( J% i7 X/ b)
)
7 x# k4 }4 U2 C6 d9 Z; S. Y9 r(defun fx(ang)
(cond
9 g& ~+ [) S* m; E8 K! x0 [( D((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
* H* n2 B$ A" G6 h5 p((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
! H3 C9 j0 a! g0 v((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
1 Q" i7 s' R+ r* Z4 l)
$ G/ e4 K7 O! D& w. j3 n% X)
7 i, ^# L$ P4 ^& s/ y& a(defun add_solid(p1 p2 p3 p4)
" w" m5 d, }, f- j8 U; R8 s(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)
9 l8 X% d! t$ ~( ^$ B% V/ L)
)
)
2 \; h+ t* K- r(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)
(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)))
% p$ M/ D1 P2 X0 I9 a- d)
)
)
0 D( C$ o' @$ l( b( \2 K(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))
(cond
((= name "3DFACE")
0 F/ s1 Z* I! Y2 |2 I(setq lst (list "【三维面】" laynm))
% c, }' ]0 x1 t. m2 D1 g# d  v)
((= name "3DSOLID")
1 Y. A; g! q8 }! Y(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "ACAD_PROXY_ENTITY")
(setq lst (list "【代理】" laynm))
5 P5 j8 s# Z3 ], [$ H  r6 C: K/ d)
((= name "ARC")
; ?/ i2 K" d% T/ ]7 s(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
: |  j/ \, K) b# u8 t(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) "度")
  n* {5 w" ]# F+ k7 e5 G(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
9 F3 ^% \# s' _& {: Z))
+ g  s7 J/ g+ P- C) q. Q)
. u3 H/ c$ H& f6 m6 d8 n((= name "ATTDEF")
(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
6 G4 z# l* O6 R7 f- A# c5 T(strcat "提示:" (vla-get-PromptString obj))
: s" j" g5 Z4 O& U(strcat "缺省值:" (vla-get-TextString obj))
; r1 q5 j4 B2 H# `6 b' a(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
% }9 V. \# ^3 Q+ _( j4 @(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
))
1 J5 E* |7 c0 w8 o9 A3 |)
((= name "ATTRIB")
8 u, j2 G$ s2 O- Z7 {9 ](setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
: e' d8 M) b3 U8 p* e1 a* ?(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
6 a) Q+ F6 Y5 _& Z(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
7 B3 i. G5 A1 {(strcat "文字样式:" (vla-get-StyleName obj))
))
)
( O, A. U& w; v! {, c1 @" O((= name "BODY")
) X/ _- U1 |! A2 }5 _/ v( m(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "CIRCLE")
( [* r, [2 Q1 S+ `' ~7 R; y- O# \(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
. R! H8 I7 ~* b) k! Y(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
  c! i9 h+ K2 ]' n+ N))
6 j. A$ _, l  }6 V)
((= name "DIMENSION")
(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
4 t  K5 ~, C$ l% \! V" K( A) l  U8 O(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
))
) S- a8 i' \1 h) z3 ]* b)
  H1 F$ X6 A3 e" V((= name "ELLIPSE")
8 f5 a0 G. b' P9 t% G( d+ ~1 C(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
* D0 i) g" S- Q5 ?3 B1 }( Z; M(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
5 M" R  R" t  l2 k+ I$ K(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
# H! a4 Y" w) s0 u9 f4 v(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
- i. E  y9 _2 T) j' S- z))
* [+ A8 I4 R' n/ g3 }8 C5 S)
/ J/ t' R2 x5 c9 u, c; R5 Y. ^, @((= name "HATCH")
(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
$ g; X9 w# S  B( i/ ]7 G(strcat "角度:" (rtos (toang (vla-get-PatternAngle obj) 1) 2 1))
* ?3 N8 S4 F$ Z, ?! c- B. d1 p(strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
; p6 W2 n7 J7 y  ^, O% z(strcat "关联:" (if (= (vla-get-AssociativeHatch obj) :vlax-false) "关闭" "打开"))
# M7 B6 J3 f7 i(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
, K3 m5 c7 Z, o) ?, P))
)
((= name "IMAGE")
(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
8 Y9 z, R, q- t0 ^+ X" K" \)
((= name "INSERT")
  ?+ E9 z: A( b, v(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
: A$ b5 K- @! F' H/ d9 }(strcat "X比例:" (rtos (dxf ent 41) 2 1))
$ j& \( Y4 Q' x(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
3 t2 Y  [( f2 P4 t7 F(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
0 T, G* W1 @+ J; ~/ Z" l1 \: E5 ?(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
)
6 ^/ B" U  K( d/ U1 x( C((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
6 p5 h- X; k6 v: X))
)
& h( a1 @2 N" B8 s  n7 e((= name "LINE")
% X% B" m- ?9 G" Z' u(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
))
% Z# j0 ^, f  o" x6 m% J5 z)
$ K* i' F# w( ]' n/ [' e7 a6 y((= name "LWPOLYLINE")
(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
6 x0 x7 j: T. [* }- t5 ]! A(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")

, Z7 T# o* t) K" t; U4 r                                                           ;;加上一个可以查闭合多段线周长的功能,显示
                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
) ^, ~' {* e# \# ~4 h- x3 m)
4 A: \+ ]- N- [& c- ?# W((= name "MLINE")
(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
* q, l6 i+ _$ r' `# O  @(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
0 x+ t' _' W9 E3 B))
- ?$ _% O9 C. [1 d# N4 C)
: r/ K7 t& N/ D$ U; o: T((= name "MTEXT")
(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
& [% u1 c& H; }" O; D(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
7 Q+ }4 w- I9 D; m7 u% I1 q(strcat "样式:" (vla-get-StyleName obj))
))
; E9 \  c. o$ v7 M9 F)
$ R1 }) I7 y7 S' {((or (= name "OLEFRAME") (= name "OLE2FRAME"))
- h9 t1 @3 d0 M" P(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
( X- Z- I4 U- W: I((= name "POINT")
/ O: o( f7 [, B# @) c* C(setq lst (list "【点】" laynm))
)
((= name "POLYLINE")
9 J- U. f) T/ \" ]8 F: I! Q1 j(setq lst (list "【三维多段线】" laynm))
9 G$ z" H2 G. p& K" Z( ]( p9 [)
((= name "RAY")
(setq lst (list "【射线】" laynm))
0 m3 Q- X9 X$ M* H! ^4 V8 Y& v4 t)
' N7 W* {  X9 N  z8 Q((= name "REGION")
(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
! ]4 I. }! C4 q/ j)
9 `6 }" j  x8 x" l((= name "SHAPE")
(setq lst (list "【形】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
9 n, O2 e: B, U. Z(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
. h2 m' N9 N; O(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
% T5 D4 t- j, \2 T))
)
0 S, n8 U5 Z2 L1 K((= name "SOLID")
' A( D, a3 t, X- |(setq lst (list "【实体】" laynm))
5 w* A4 L' a+ r)
. H8 P/ X( H5 r! f((= name "SPLINE")
(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
% j" f- ], \" k' E(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
' b' R+ ^1 q+ X. Q; s- J  l))
)
0 h$ ]1 |, a5 A) |& j6 n  Z6 w((= 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) "度")
(strcat "样式:" (vla-get-StyleName obj))
3 o  q- @: f) M$ _! L  l3 L(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
)
' G* R+ k2 d" h6 l. _((= name "TOLERANCE")
(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
7 `* p8 y1 j6 V7 _(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
))
7 B) p/ a4 r2 |  b' s0 Z  i)
% @7 @) V3 y, E((= name "TRACE")
. t' S+ z) ]& T$ c6 m(setq lst (list "【宽线】" laynm))
)
((= name "VERTEX")
" B7 E, C& P& X; R$ J+ [6 x(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
/ J- l: `; s' y(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
(strcat "凸度:" (rtos (dxf ent 42) 2 1))
% I! ]; E3 V( ?( g7 [! M))
% I" c; F9 F" a% m" B)
((= name "XLINE")
; V& j2 P5 \- j+ I# h(setq lst (list "【构造线】" laynm))
)
; [3 y* i, C+ p(T
) \/ O* z1 N( g) V1 V(setq lst (list "【未知对象】" laynm))
)
)
(setq ss (ssadd) h (/ (getvar "viewsize") 50))
' ^& N- `5 N* h! h4 @2 s( N(setq ang (fx (angle (getvar "viewctr") pt)))
& O! Y$ x0 L# j- C% X7 Z(setq n (* 1.4 (1+ (/ (apply 'max (mapcar 'strlen lst)) 2.0))))
: q* M  Q' K* {( Z5 b) G1 b(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)))
6 S; C* Q' o0 N, ~# C& V( H(if (= (caddr ang) 0)
(setq pt (polar pt (/ pi 2) (* 0.4 h)))
0 `. x) X, s& I; ]5 {) l  E(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
8 a# b( O7 \4 y# n9 R3 I- s)
  F# _' t. w$ G6 ^& U8 z; @/ X  |(setq n -1)
(repeat (length lst)
(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
# ~* \& K! p9 Q( w) l0 H: J8 \)
. U) j8 n2 p" M$ k)
2 v. L; @1 K/ i! o) I* F(vl-load-com)
8 @5 i! Y, y" I8 K  {(command "_.undo" "_m")
(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error* *error* myerr)
(setq oldos (getvar "osmode"))
3 `& t6 ]$ [: R6 n3 q2 R(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
! P9 y8 B) F& S! d: g( ~: C(setvar "fillmode" 1)
2 P: ?( d# Q0 D! b: d(setvar "cmdecho" 0)
& C, V. D( J7 S: o" K(if (not (tblsearch "style" "宋体"))
(command "_.style" "宋体" "宋体" "" "" "" "" "")
7 L; ?( D. f3 V! O' p% s)
(setq ss (ssadd))
(while (not pd)
(while (not (progn
0 \$ J4 f/ H$ Z" R1 J(setq gr (grread T 1))
; C" V! g! G# J4 v2 m6 N  o6 M(if (= (car gr) 5)
* j7 o  m5 M9 o7 Q(setq pt (cadr gr)
; C. @: Q  j, b" s2 hent (nentselp pt)
2 Y+ k" V* W0 I1 Cent (if (and ent (= (type (last (last ent))) 'ename))
1 t/ A9 e+ R8 o4 C6 K, C: S# B- m(last (last ent))
$ Y0 P4 ?! K% z(car ent)
- Q) b* a+ W4 f( W; v)
)
(setq pd T)
0 E: s) p: |8 w) v)
))
)
(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
0 T) Z& X4 Z& @& g( u9 \; L' d(if entold (redraw entold 4))
) J) @5 }, v+ @2 i(if ss (command "_.erase" ss ""))
# V7 h1 q' [8 d, V(redraw ent 3)
8 L. o: c: R2 D  g(dis ent)
* ]8 R& @7 a5 U$ E, A(setq entold ent)
4 B1 R+ L2 j1 K& _, _9 S/ G)
% \, F2 y/ r( y7 q6 [)
)
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
2 K! B1 {( F: _- L- t9 r/ H(setvar "osmode" oldos)
- l4 y& z& j$ l+ w" E(setvar "fillmode" oldfill)
(setq *error* olderr)
0 Y4 Y6 L% b) |1 ~% w(princ)
)

十二月

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

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长