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

A云

这是个动态查询的程序，想在里面加上一个可以查闭合多段线周长的功能，显示出周长的长度，还显示一个周长乘以可以输入的一个数的等值，这样方便用来查线割的价钱，有哪位高手可以加上去的请帮帮忙，谢谢了
9 [& x. G/ t! ^0 ~$ P) A
3 p( V: s1 y0 w5 ~

(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
                                                  ；；输入一个实数
5 {) {3 p2 b+ ~; V9 O# E; J' T
(defun myerr(msg)
/ m  u# M7 ^8 _$ ~9 G1 e& `6 _(setq *error* olderr)
6 H/ c5 @7 `6 e8 D% H& V6 @( @(command "_.undo" "_b")
1 d2 z2 @7 V/ z+ G" E(princ)
)
# m. X' t$ h; Y5 A8 @6 Y! n( u( ^(defun dxf(ent i)
(if (= (type ent) 'ename)
; K7 V9 Y6 a- K# H) y(setq ent (entget ent))
, h- l9 \9 F# s6 V3 g2 T+ k)
(cdr (assoc i ent))
3 G9 b8 ~5 X8 A" {0 Y7 ]+ i  O8 P)
; K8 {0 `! h7 h2 \' X  W/ D(defun toang(ang i)
4 P/ I5 Y) _9 y(if (= i 1)
(* ang (/ 180 pi))
" O, s1 W  V2 l. L! a(* ang (/ pi 180))
4 A. ?( k3 e7 N4 q)
)
$ d" Z5 g7 z; ^! c(defun fx(ang)
4 s7 H) j0 O4 m7 X% U. `/ M: @1 g4 ](cond
) [: I4 l. ~& s, W5 j# v((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
' x. x$ x7 n1 |6 F" a" l((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
$ J$ z( l* H, z0 f+ C((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
: J" ?, O# d3 D- x  d((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
)
3 w, T$ x9 s- h1 a5 _- {: c)
(defun add_solid(p1 p2 p3 p4)
; X# |8 F4 w& R  Z6 o2 V/ X& ~(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)
)
* y# q- q/ ^- r)
% M, I- Z8 A6 m# Y)
(defun add_text(pt h ang txt style jus)
) r/ b) E# }, J  p& v8 u(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)
( q5 f$ t7 E& D(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)))
)
)
  _" o6 \: S, X" k9 B- d7 z)
(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
& r: O4 s" T& {0 {3 ?, t(setq obj (vlax-ename->vla-object ent))
(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
(cond
((= name "3DFACE")
+ ]) Z( q! v5 @0 P7 u; q/ P# d(setq lst (list "【三维面】" laynm))
)
) l: L$ M: }6 G8 i9 \((= name "3DSOLID")
( F7 y7 Z0 l+ ^% B(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
" ~2 H2 a9 J( i7 t5 r((= name "ACAD_PROXY_ENTITY")
! c5 N" F* `7 X(setq lst (list "【代理】" laynm))
2 ]5 @' \& Q. [$ }$ S6 M* a2 ])
0 y# p# \8 x  q# H) o; \$ \((= name "ARC")
(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
- v  P/ q0 R: v(strcat "圆心角:" (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) "度")
4 ~7 B0 o6 c" j5 t(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
' [! }1 J  l  H( p/ k) E(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
))
. `! h: O, ^" d)
+ @) ]3 n3 y  g4 R. a- X((= name "ATTDEF")
/ o% H4 v& D5 G* `(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "提示:" (vla-get-PromptString obj))
2 w4 `% p$ X  @6 {$ W(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
' n# j4 P) z% V6 X" t( e  k8 W( k(strcat "文字样式:" (vla-get-StyleName obj))
))
)
" L, D$ l* P+ R( k& }((= name "ATTRIB")
& v$ G7 {1 K6 N" ]' x(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
' R* W9 d/ c) @* k(strcat "缺省值:" (vla-get-TextString obj))
/ ^% {0 s7 c% R. t(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
; T: n$ H% u* n! x5 ~1 q: x(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
- s9 [7 i, o2 a, Q* q" B7 K% @(strcat "文字样式:" (vla-get-StyleName obj))
))
)
((= name "BODY")
4 D" X# f2 M, S3 @( w9 z(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
. ?) H- `1 \; f)
((= name "CIRCLE")
(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
" w. \, B+ j) k" n2 @(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
% q/ |; Z. ]  a. d: t)
((= name "DIMENSION")
/ Q3 W- t. g# S1 r(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
' C1 M& @+ z) [+ K( U0 y(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
  Q$ {1 e2 t+ g. {" {))
1 ]- O7 P1 }1 S: [. w)
((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
5 Z9 E1 E. _8 g; U/ k(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
' {3 L8 f& E9 ](strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
. r9 b$ s7 _, P4 u(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
)
2 o9 J) S. t+ ]((= name "HATCH")
. X1 \! P9 f+ R; p# k2 e- o3 T(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
(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) "关闭" "打开"))
" h' Y$ Z# Z2 e(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
- Y4 b$ E2 M- L7 R8 E# p5 T))
)
# J4 ]/ p$ P. ]6 d((= name "IMAGE")
: L6 L0 r* s# G; y& c! H2 Z(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
)
((= name "INSERT")
0 r, ~( l: A  T  I3 {3 j(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
(strcat "X比例:" (rtos (dxf ent 41) 2 1))
+ e: n% O" h( x(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
. Y% B: y& o7 y' O( J: o7 M(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
/ E' C' e, K( w(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
; `0 E% f# b6 F))
)
$ \, C- S. N+ r2 y  a9 y0 \  b((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
4 l8 b( ?6 N% ]& \5 U(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
))
: y8 U2 _6 ?! `( L)
* z( k& f( s8 b((= name "LINE")
" Z. b5 t7 Y9 b& b(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
1 V# I3 n$ ?9 r3 }& `/ A8 _(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
; R/ q$ y7 q2 }- B' j. [))
' f. ~( a( K/ k/ [: z( o)
((= name "LWPOLYLINE")
3 @$ _0 X3 q' z* ](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㎡")

& O: D$ q# w$ c6 S: g                                                           ;;加上一个可以查闭合多段线周长的功能,显示
! e3 c# g' p5 f8 A( Y5 e3 R                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
2 F) ^4 o% J- B: `)
' {& ]0 H, k9 l/ d3 ~8 j((= name "MLINE")
(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
))
! I- Y; K& O: })
((= name "MTEXT")
(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
2 S, B7 f$ K" f! t9 \8 o2 b(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "样式:" (vla-get-StyleName obj))
))
)
0 s9 J: Z0 S% K  S9 ^" ]- O7 W((or (= name "OLEFRAME") (= name "OLE2FRAME"))
(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "POINT")
) v2 ]7 e5 e' H3 y(setq lst (list "【点】" laynm))
" M2 W' N* _9 z% V)
((= name "POLYLINE")
4 p# u5 N9 P# f(setq lst (list "【三维多段线】" laynm))
& T* c7 g4 M3 J" A( m  U& u)
  h- n( b% E' O0 o7 h/ r((= name "RAY")
/ K. x1 ~" j0 E1 v(setq lst (list "【射线】" laynm))
)
0 @8 Z1 k5 D% c7 |, S0 @$ i, V((= name "REGION")
(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
' Z5 V# l; m. q- e((= name "SHAPE")
6 S8 ~. p  z3 q, ?! u(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) "度")
))
)
((= name "SOLID")
(setq lst (list "【实体】" laynm))
' M: b  Z- D; j- s8 ~)
((= name "SPLINE")
- J' b) R' u( y(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
/ d  l% [0 u% N2 i* E0 X(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
9 P$ x% G2 q& p))
)
((= 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))
, x: u" p1 Y4 [0 ]. s' }(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
: a- Q& `7 F7 M2 ~6 q* E"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
+ S4 J9 n0 h; A: C3 B$ T0 F3 }))
8 ^6 G% ]' B, S* k  @. p" o)
((= name "TOLERANCE")
(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
, F; b; _- D' \" q  F8 X% ?# N(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
! m% t4 m0 W6 d# P. n$ Z; F))
)
((= name "TRACE")
. C* O$ }( R3 ?% m: C2 @/ a(setq lst (list "【宽线】" laynm))
  M3 E- q- C3 w- p8 w)
2 `; w* i6 }! T3 N0 j& |& J) q((= name "VERTEX")
. `# y( P0 @; N8 b# `* q5 r( a(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
& G' K, ?& }: ]  `: G4 J& V(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
(strcat "凸度:" (rtos (dxf ent 42) 2 1))
/ h: d, e! k6 ^8 I+ _0 @0 d))
)
((= name "XLINE")
(setq lst (list "【构造线】" laynm))
)
& c& s& W* Y6 n3 z+ R7 B5 A$ Z4 R(T
9 \! w! u, w. o2 {, d(setq lst (list "【未知对象】" laynm))
)
0 {1 I/ E0 S5 a' X0 u+ ~)
9 _' M& X4 f, B! p9 i, N(setq ss (ssadd) h (/ (getvar "viewsize") 50))
(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)))
) p, t) W# {2 y3 ]! l(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
, q+ R" [4 @: o+ X5 d)
5 b/ u& @% Z5 H/ v$ r0 K. C- a(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)
)
3 g( \( _" B! `7 q8 r+ y)
/ N! Z1 e6 H" W  r& @. X2 [(vl-load-com)
9 Z1 n7 N  I3 C8 m9 Z! H; K(command "_.undo" "_m")
' Z1 F6 K4 @& S. a+ n! L(prompt "\n***移动鼠标掠过对象查看信息！***")
# J  D5 h) w8 _% o(setq olderr *error* *error* myerr)
(setq oldos (getvar "osmode"))
  `$ x7 ?) Y9 q* q7 C(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
(setvar "fillmode" 1)
" Y0 V( w. H4 G* T0 b2 D(setvar "cmdecho" 0)
(if (not (tblsearch "style" "宋体"))
8 l* g3 h/ P2 P9 g. T(command "_.style" "宋体" "宋体" "" "" "" "" "")
7 L# g2 ^% P/ p( \& K)
(setq ss (ssadd))
(while (not pd)
' G2 w3 C6 T. r0 P* l5 O9 O(while (not (progn
$ d1 m# k4 ~* K: C# ^/ p(setq gr (grread T 1))
(if (= (car gr) 5)
0 n9 R; ]2 D8 o+ p" a! v(setq pt (cadr gr)
2 ~: k& |3 v  r, pent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
(car ent)
1 C- x0 `" k5 q: D& q: C% n)
)
(setq pd T)
)
))
)
(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
1 G. r# B/ b4 i& f& W. Q(redraw ent 3)
7 n- y2 g+ F$ V2 [" a3 f(dis ent)
(setq entold ent)
)
)
)
7 {5 z( t9 H/ U& Q0 m! ]2 {(if entold (redraw entold 4))
' l! x2 o. U+ G% `" n(if ss (command "_.erase" ss ""))
(setvar "osmode" oldos)
3 p. ^3 M6 C+ u& Z( Y: ?( [(setvar "fillmode" oldfill)
5 f+ x3 j6 z) Z& Z  z# V) ?(setq *error* olderr)
( I/ x0 n. {1 v+ y  M(princ)
)

十二月

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

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长