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

A云

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



. m/ h3 Y1 S8 M, N1 H; b: }(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
                                                  ；；输入一个实数
/ `: ~7 H6 ?8 O2 j3 r$ Q% M
! p( `* ]# L) J, y(defun myerr(msg)
(setq *error* olderr)
(command "_.undo" "_b")
(princ)
)
(defun dxf(ent i)
: {5 w# j$ U0 `(if (= (type ent) 'ename)
! z1 r' l9 {8 U$ B(setq ent (entget ent))
* }% G, R2 c5 \& B/ V) k" C3 c)
9 _$ D- c- [& y+ y6 A+ o! a+ L* V. d$ B(cdr (assoc i ent))
)
(defun toang(ang i)
6 ]# t, G7 s! G0 w6 }(if (= i 1)
(* ang (/ 180 pi))
(* ang (/ pi 180))
: q* B, t" O0 v; W* A) U" {)
( ~' b& A6 K. D% C! |! t: \7 R" A)
1 y5 T! W2 t$ ^6 Q' Q5 ?(defun fx(ang)
" v$ _; p, R2 ?% g(cond
. j& N/ J. c; a8 X% e8 m& u+ A((>= (/ 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))
((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
7 V2 i! u# @& Q)
)
(defun add_solid(p1 p2 p3 p4)
: N: ?7 Y. D  F( \(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)
" c9 I) v8 h$ X: `: p8 y)
9 i7 W+ ]% Z7 f: {2 H' q)
)
(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)
- {8 C& R, Z9 e& C, L! t(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)))
3 d6 z1 ?6 Q! N, ^)
)
)
(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
( D/ n3 X  x& J1 {. n' l((= name "3DFACE")
(setq lst (list "【三维面】" laynm))
# F& L$ H. f! P- [2 L2 V)
7 i3 N$ P: T% Z# U. O, l! z5 p((= name "3DSOLID")
(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
5 ?4 M+ p/ p( J" g; V% ~6 J9 N9 |((= name "ACAD_PROXY_ENTITY")
0 o3 y8 S5 R9 B$ J(setq lst (list "【代理】" laynm))
0 G( ^0 x# W, ^8 V2 g)
((= name "ARC")
(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
/ q2 v4 P" `. X, i* A1 R(strcat "圆心角:" (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) "度")
(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
; _4 \# {# l  `% D: x(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
% {5 H6 H! n. P(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
  H; b& \* G% R4 p! Z# n1 B5 Y))
)
((= name "ATTDEF")
(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
5 E$ n: l1 z; q# U" P/ F(strcat "提示:" (vla-get-PromptString obj))
(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
$ M% ?6 H( c$ `3 Z3 r$ Q6 H( g3 T2 ^(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
% k. N, f$ t& k- q(strcat "文字样式:" (vla-get-StyleName obj))
& T. m8 ~+ O: |3 w; |$ x3 _% g, G))
)
6 V4 X6 R( e( o. d# 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))
" E7 d, G5 q- J8 M(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
3 z7 R8 {2 H+ U) X7 E(strcat "文字样式:" (vla-get-StyleName obj))
))
)
) B2 l1 d( K9 ^$ D. p  {8 [((= name "BODY")
- B& `( P+ }8 I6 x3 `(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
. W- E2 h3 }. ]2 a- H' u) K! I; g((= 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㎡")
4 x- C- e6 r9 ^- U. f( A1 O))
)
((= name "DIMENSION")
(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
1 M1 R+ ^8 q2 R/ ^6 n2 y(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
6 t' b+ [' I$ h+ `+ ]))
: O+ |( H3 K% G2 e)
4 n4 n* k) U: H' e+ \. H1 U0 s((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
; \. m. K3 T& E' c7 b  m(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
9 p& f, d2 I$ W/ y! ^(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
+ N( b7 E( N# F8 e(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
  _) X8 S' _1 X8 ]5 w6 s))
)
, T0 A. A9 ]1 t; p+ T/ ^((= name "HATCH")
; _, \5 h, A6 [; G$ l(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
(strcat "角度:" (rtos (toang (vla-get-PatternAngle obj) 1) 2 1))
2 n2 A: w, y2 \! P% r(strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
(strcat "关联:" (if (= (vla-get-AssociativeHatch obj) :vlax-false) "关闭" "打开"))
* m3 L7 z. D' J4 I4 N) \(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
$ ^" t9 S, }) A( u9 w3 s) |))
)
! s: Z  ]; z$ P5 W/ b5 q  h( p3 L((= name "IMAGE")
(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
)
9 E6 ], @' w, K* d/ h. t4 v((= name "INSERT")
. r, T$ X1 {. m* z+ J+ o9 Q. h- L. K(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
(strcat "X比例:" (rtos (dxf ent 41) 2 1))
(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
5 S/ r. S' [+ N+ T(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
% d( M$ ~2 l9 B6 t2 u6 x$ o: e)
((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
))
)
((= name "LINE")
" O7 u* _: ^6 j! _. Q. R(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
# k- s8 x( p% \% p) K, Q. _(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
))
9 f( a  a! }6 Y" o! X% `)
((= name "LWPOLYLINE")
+ V# H1 B, `. I$ U, ~$ x# c$ Y$ n(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㎡")

                                                           ;;加上一个可以查闭合多段线周长的功能,显示
$ ^6 k7 b6 x$ [( d( I+ P' t                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
# L% b7 U, O! r/ G# |0 Z)
((= name "MLINE")
1 n% \5 k% Y+ W2 Q5 W4 W; J(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
( u+ C* ~  M- N; f0 I3 k/ W(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
2 x; U. U3 j4 c! B; ~(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
))
% T' |' {% k/ E  Q  V6 `% ^% v7 ^)
7 Y, ^9 P' j- ^0 |1 c((= name "MTEXT")
' r+ x/ |; w" V5 L6 e/ K(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
7 r5 f+ [, j- x( @: p(strcat "样式:" (vla-get-StyleName obj))
! z; K" y% e' h. [. y; i))
)
((or (= name "OLEFRAME") (= name "OLE2FRAME"))
+ T) [, J: s+ v- o(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
$ d3 ]( T/ x! M2 {% u- \)
((= name "POINT")
: X( V5 n& b6 C1 n0 p( a; S: N+ M(setq lst (list "【点】" laynm))
9 B+ [5 p; o& P3 J  }; @5 _6 ])
2 x* h* r" [5 ~- D((= name "POLYLINE")
: i7 r- ~! a! s; \(setq lst (list "【三维多段线】" laynm))
3 Q, b9 J" q$ U4 Q$ p4 P)
((= name "RAY")
(setq lst (list "【射线】" laynm))
5 Y- b8 U* S) j) W8 ?5 V)
((= name "REGION")
3 I% R: t5 v$ |) x6 g(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
: R5 W% l8 {' Q/ I, o& ~' O  o)
' [# S' m9 z  g0 Z- F) w((= name "SHAPE")
( `( H6 [7 ^3 \  C(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) "度")
))
/ U( t5 v0 w4 _2 c( G)
$ y* G: T! j! x  _2 a- B((= name "SOLID")
(setq lst (list "【实体】" laynm))
)
* O! T& `! |' w, @((= name "SPLINE")
(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
6 }2 f$ x" x# U; u1 I( b3 `# n(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
0 [! D% j6 y5 b( E" [! @2 D)
" l1 A' h; u1 W4 b1 @((= name "TEXT")
(setq lst (list "【文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
6 N' }0 t& O+ W7 z4 {(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
1 H% `( W6 t3 i( [(strcat "样式:" (vla-get-StyleName obj))
(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
! @, V7 P. k; y! g% K"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
. {# ~4 U( l! P: ~+ y& R# K)
((= name "TOLERANCE")
. N( u. M! \/ m' H(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
: T! A0 D9 B* e$ T" ?/ o" |- V(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
))
! B5 |0 w/ S9 |+ P- |) o5 @)
7 w! {; k+ z; h, h! K((= name "TRACE")
(setq lst (list "【宽线】" laynm))
)
((= name "VERTEX")
/ }8 Q0 [% p. @/ j2 y- J(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
' `$ _" [: R" f9 i! B, I9 u(strcat "凸度:" (rtos (dxf ent 42) 2 1))
5 E- ]; m! h! S8 F9 T))
)
, v" r1 k& u, Y; F' k((= name "XLINE")
' A1 Z) q  R3 D6 @(setq lst (list "【构造线】" laynm))
! c. Q7 |* E/ i- @)
$ W8 `. N, {( J4 `7 O(T
(setq lst (list "【未知对象】" laynm))
)
)
9 T- |1 V+ I5 Z) D! |(setq ss (ssadd) h (/ (getvar "viewsize") 50))
(setq ang (fx (angle (getvar "viewctr") pt)))
4 \- |% Y. {# S(setq n (* 1.4 (1+ (/ (apply 'max (mapcar 'strlen lst)) 2.0))))
0 u) F4 m/ f/ ^, f% m- H' h+ e( C(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)
. r, Z6 C1 N1 p  s(setq pt (polar pt (car ang) (/ (* n h) 2)))
(if (= (caddr ang) 0)
) a3 G1 L) K0 L( H" [( v  C1 t( u1 G(setq pt (polar pt (/ pi 2) (* 0.4 h)))
! \7 l3 y3 {" ]) M(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
* ^+ R" d$ @  B3 ]7 l4 v)
# T0 U+ o8 P" ]) d/ R9 A(setq n -1)
$ ^/ m# V' g* A0 S(repeat (length lst)
/ e' L7 c8 H+ |' c, `1 y(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
$ o3 m- j9 r1 g& _6 \)
)
(vl-load-com)
2 a4 F& f+ e: ~9 v$ \+ o* j: C  W$ Y(command "_.undo" "_m")
7 v! y0 B: w; z2 F(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error* *error* myerr)
(setq oldos (getvar "osmode"))
) g" q& {! [' A5 n2 i  X(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
' w) \4 B% S. a! Z) ~+ g+ z4 Y3 \(setvar "fillmode" 1)
(setvar "cmdecho" 0)
- L0 }" x) Q' f0 C. P# i2 S(if (not (tblsearch "style" "宋体"))
+ q; ~; O2 I$ f(command "_.style" "宋体" "宋体" "" "" "" "" "")
)
(setq ss (ssadd))
(while (not pd)
(while (not (progn
(setq gr (grread T 1))
(if (= (car gr) 5)
(setq pt (cadr gr)
ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
- u; k2 X2 r# x$ h(last (last ent))
4 S7 H& P4 `0 S! E(car ent)
9 U9 P8 V1 H- l( L+ b9 ~)
)
(setq pd T)
6 a8 a, o3 P; j7 o7 A2 K; X)
2 r1 [, I5 b" n+ e0 I))
: v! a0 d; l; H# ]. g  _)
; _( r& t! ?" o1 R% w$ P0 Y(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
(redraw ent 3)
(dis ent)
6 |5 h# G& c: o0 K2 G) S- ]2 V$ [(setq entold ent)
)
. z& |( ^% z% I1 k* f# G8 @)
)
, c6 @7 |8 _; ](if entold (redraw entold 4))
) ?; a! N! r" p) J, O6 l. j(if ss (command "_.erase" ss ""))
(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
(setq *error* olderr)
(princ)
9 @/ P% q: Y8 N2 B* N, A0 k)

十二月

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

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长