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

A云

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

5 I" B) r$ c% `! R+ E5 x
(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
7 n  z$ c# R: {! N" {- l4 G! c                                                  ；；输入一个实数

(defun myerr(msg)
(setq *error* olderr)
(command "_.undo" "_b")
(princ)
)
(defun dxf(ent i)
(if (= (type ent) 'ename)
9 A3 [" a! o: o9 |$ A0 y(setq ent (entget ent))
)
(cdr (assoc i ent))
)
: O& I3 ^( y* w/ X, z(defun toang(ang i)
(if (= i 1)
7 }$ L1 f% d6 h(* ang (/ 180 pi))
(* ang (/ pi 180))
)
$ s# T/ ~. x# ]  h)
& Q/ f; p: C/ W& Q* ]  T+ }(defun fx(ang)
(cond
((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
4 W# J9 A, G$ E7 X/ s((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
)
) @9 E% p4 H0 w) a1 J# `; I0 |. U7 E5 e)
(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)
$ C: F/ k( U* W% s' b1 g/ F' {, K)
/ e7 N+ K6 Z( f+ o7 b# Z)
)
(defun add_text(pt h ang txt style jus)
; e- R- k2 H& g: ~; Y, ^' u/ ]* L(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)
/ h4 L1 a- q* E$ Z(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)))
' ]$ S- h# Z/ y+ k7 y% B)
)
) D) p5 d) Y* R$ c+ W4 h: O  F)
1 T1 p: F6 b. a9 A: k* E! {(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
* n8 J6 @8 g9 L9 O, d2 K; b(setq obj (vlax-ename->vla-object ent))
(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
(cond
' h  ?2 t# Y3 b, W; `((= name "3DFACE")
(setq lst (list "【三维面】" laynm))
)
/ R' S/ e, a7 d6 X((= name "3DSOLID")
1 z* `* z1 I0 p. L  z- f(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
, X/ J2 k5 w: G5 H% t)
2 n7 C$ N  m9 ^; X6 E" T5 f& _0 q((= name "ACAD_PROXY_ENTITY")
7 ?6 M! l" J+ A' `5 D(setq lst (list "【代理】" laynm))
)
9 u5 I2 g8 m* I' I((= name "ARC")
8 ^0 Y, a& Z. v$ \(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "圆心角:" (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) "度")
( @# O& V! C# O7 O0 E(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
' ?+ p% l0 [" q/ x  R4 T(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
4 o& P4 ?- t8 z2 i(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
; H8 u  [$ g: W8 k% a6 z(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
))
)
# V0 e+ C( E$ d((= name "ATTDEF")
8 V- x' s2 X- C' c" |, q! Q5 x$ ?+ N(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "提示:" (vla-get-PromptString obj))
: Q! J3 d+ B2 b$ e4 U(strcat "缺省值:" (vla-get-TextString obj))
# f, w) d8 Y1 Y! @, G(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
/ f; w3 C- {; \5 ?7 B))
)
* x6 ?2 T8 X# ^3 \((= name "ATTRIB")
(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "缺省值:" (vla-get-TextString obj))
* y# Z, z% W& U- G(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
* F* N6 l+ ~- Q(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
( @& b/ x' M* `% z))
- a4 J' ?* g6 q7 A)
; M: L  p+ ?, e2 V/ d! ?4 L((= name "BODY")
(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
$ I8 X7 r, K! a( I1 Q" P& |5 Q((= name "CIRCLE")
(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
) f) C' b+ N- s) i' h$ k! Y(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
+ M! e/ S7 R6 w* W" j)
) x5 y  q1 }/ b* J+ B9 }" N((= name "DIMENSION")
(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
$ W3 S& J& s) T' `+ p(strcat "文字样式:" (vla-get-TextStyle obj))
+ e  _3 n: J: v7 |(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
4 {4 C, {* [2 |  [(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
))
7 @" ~) c' t3 [4 l6 }7 X)
) J- Z9 O% P) d) [+ Q3 p: u) h((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
7 c% A2 M- c6 r" _1 M1 f  \) c(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
" F3 \; H$ m; j+ e(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
" {3 Z- B1 U% Z* W# q))
) G2 u- f; k3 G+ s: v& N3 e)
((= name "HATCH")
1 }8 y2 l+ N& H(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
(strcat "角度:" (rtos (toang (vla-get-PatternAngle obj) 1) 2 1))
  U# c+ e7 z$ Y" r(strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
/ Y, Q8 ~1 E6 Z" a(strcat "关联:" (if (= (vla-get-AssociativeHatch obj) :vlax-false) "关闭" "打开"))
(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
' j5 }0 j% ~$ k5 A" K+ y))
6 Z) L+ l( Y* |" C- G7 t)
((= name "IMAGE")
(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
)
4 i* _' J! g; V. ?/ W  S2 Z  A9 @( N((= 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))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
& m9 N7 l6 k7 U6 T) m0 N& [6 w% C" o)
((= name "LEADER")
8 Y2 l: d0 t4 F6 \4 z(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
))
2 {( O, S, g! V# q) B. \$ q)
. s; W" [, }3 {5 C+ r+ `7 L((= name "LINE")
7 X$ J5 f+ |; D. B8 }; P(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
# N, o- q( A" l# P(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
))
)
((= name "LWPOLYLINE")
(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
6 g8 E$ _  A1 {* t, H8 q% T- V(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
1 z8 ]5 R3 X4 o/ _/ T4 L6 a
                                                           ;;加上一个可以查闭合多段线周长的功能,显示
                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
. k' L  d, X& p+ P* s7 ~)
! W, F+ X! n: P" K((= name "MLINE")
(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
& k3 s# |6 D$ j+ R' D6 Y(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
))
$ ]2 C" S9 l  B  t7 K$ z; I& s3 ])
((= name "MTEXT")
1 O% L7 v2 t1 E2 L* _# G+ S(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
8 h  V4 Z% P: L9 H: L(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
) k# |9 R$ m" J- c4 p(strcat "样式:" (vla-get-StyleName obj))
))
0 C" {8 b4 S9 E; |4 N4 B; i: ~)
) V: n0 u# J, H: `# G. M% c((or (= name "OLEFRAME") (= name "OLE2FRAME"))
(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
6 d4 D9 j% J$ X% b((= name "POINT")
(setq lst (list "【点】" laynm))
)
, z! Q3 E3 c" C* a4 i" i0 F((= name "POLYLINE")
(setq lst (list "【三维多段线】" laynm))
)
((= name "RAY")
(setq lst (list "【射线】" laynm))
1 c. C$ i% g$ |! i# y0 ?. B)
1 k2 \6 N' a  J6 ^  Y. r4 N((= name "REGION")
(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "SHAPE")
4 l, r! V! R2 M: H% z. g$ f& B/ ?8 n(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) "度")
; Y% P" ?$ `% O  A* s))
; O* _& _2 }2 d)
4 S& z" M$ _7 P2 `((= name "SOLID")
(setq lst (list "【实体】" laynm))
$ j# H. r9 ?1 Y, C/ @( D# _, ?" s)
((= name "SPLINE")
(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
; q, n0 I) D: X0 T)
7 {. u& i1 T7 T((= name "TEXT")
; m' H4 `) Y9 w* l2 S+ Z5 j8 L6 h(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) "度")
' X/ |2 D! ~( Y/ s( Z6 @0 v7 A(strcat "样式:" (vla-get-StyleName obj))
. x7 q2 [6 U+ ]$ H+ D(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
8 l( ^" O; @2 o( r7 f$ N; h"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
)
((= name "TOLERANCE")
(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
))
& V! J- t1 `; F3 c! I# x3 a)
: j6 ^" j" A" X; [  U((= name "TRACE")
(setq lst (list "【宽线】" laynm))
+ Z" u* Z2 i' l8 d)
((= name "VERTEX")
(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
(strcat "凸度:" (rtos (dxf ent 42) 2 1))
5 E1 ?, p; [, k6 h( p& H7 U0 w! r))
)
* x% `7 ^- w* ^! D: m((= name "XLINE")
& K$ w# U4 V; Z- E% y1 N( o(setq lst (list "【构造线】" laynm))
)
(T
' b: q( m. o  s(setq lst (list "【未知对象】" laynm))
)
% A4 D, F7 a5 [/ P! }- B9 A1 [. ])
(setq ss (ssadd) h (/ (getvar "viewsize") 50))
(setq ang (fx (angle (getvar "viewctr") pt)))
0 |8 z- ?8 s$ c" t5 P) P(setq n (* 1.4 (1+ (/ (apply 'max (mapcar 'strlen lst)) 2.0))))
+ U2 N" z0 @/ {8 Z4 w$ Y- M' p5 m9 @(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)))
7 j' H' F+ A: R& m4 ~& B. Q- o(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
( B' \5 j, l, j6 F6 c)
(setq n -1)
, S5 \1 @. F- w; k* M8 W! o- y/ R(repeat (length lst)
: [$ U3 ]' ^( c, M; l(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
1 b6 D/ Q8 {4 H8 s6 P- I& v)
2 V  E1 R3 s' L. B* E8 S)
3 ]& x$ f$ w* |+ w3 `6 O( N(vl-load-com)
(command "_.undo" "_m")
(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error* *error* myerr)
(setq oldos (getvar "osmode"))
(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
(setvar "fillmode" 1)
& C5 E' h9 Z; w% K/ O1 n(setvar "cmdecho" 0)
(if (not (tblsearch "style" "宋体"))
(command "_.style" "宋体" "宋体" "" "" "" "" "")
1 I, M  b5 ~5 _)
2 L, K5 ]$ |) y- {(setq ss (ssadd))
(while (not pd)
(while (not (progn
3 H+ p/ E: N" T" g8 }6 U(setq gr (grread T 1))
8 w% z- e( S2 F7 C6 E(if (= (car gr) 5)
(setq pt (cadr gr)
ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
, P8 D7 p6 [& S+ q* o& {(last (last ent))
(car ent)
. p8 ~( d7 i# r4 ?4 m+ M)
)
; ?1 t( T4 e' {(setq pd T)
4 e; D' p4 f" N5 B/ D)
))
)
(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
+ Z  t8 N6 J2 h; v2 U(progn
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
$ w- m0 {6 ?7 p+ l7 n(redraw ent 3)
+ }) M8 i2 @% K! k8 l2 w9 f(dis ent)
(setq entold ent)
5 Q1 T9 o; e' {. p$ a2 O# a)
)
)
(if entold (redraw entold 4))
% a3 s  l; s! v* h(if ss (command "_.erase" ss ""))
(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
(setq *error* olderr)
* m5 l: m9 a+ m1 ?% w2 b0 q(princ)
  ]7 a! @* ^! Z0 i4 n+ X% y) x, A)

十二月

这可以得到任何种类曲线(包括LWPOLYLINE)的总长
2 {. c: _" Y  h9 N(vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
希望对你有帮助

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长