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

A云

这是个动态查询的程序，想在里面加上一个可以查闭合多段线周长的功能，显示出周长的长度，还显示一个周长乘以可以输入的一个数的等值，这样方便用来查线割的价钱，有哪位高手可以加上去的请帮帮忙，谢谢了
" j% _+ u) Z( U% R7 n
5 `0 G! ]1 H5 [4 n: B' u
1 |* i: f* t& R  P
- `- Q) Q- Q7 }* D0 Q% ](defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
  d9 Q+ `; C+ i                                                  ；；输入一个实数

(defun myerr(msg)
) N3 S7 ~/ p5 _4 b8 F* q(setq *error* olderr)
7 A% Z$ p# X1 i& e' w(command "_.undo" "_b")
(princ)
  d4 b8 e6 M3 o  G)
8 g# f5 {) ~/ c- @2 L+ ]2 A: I0 ](defun dxf(ent i)
(if (= (type ent) 'ename)
(setq ent (entget ent))
( V3 D6 J. n* L5 |2 s# `# k1 {)
6 V! b2 Z2 z; l, e" p- F(cdr (assoc i ent))
)
(defun toang(ang i)
(if (= i 1)
" o0 q- _4 H8 R5 N6 S1 W(* ang (/ 180 pi))
& Q, J- h9 k. z" ^& e5 R(* ang (/ pi 180))
)
& R* v" T- n5 u4 V)
- Y! i6 O1 w2 {- |9 u0 [; L+ J(defun fx(ang)
(cond
((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
* V% u, u. ?* W((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
3 l, l6 P% |% f) j( ^; d)
)
(defun add_solid(p1 p2 p3 p4)
( a8 J+ x4 w- H9 `' A( O(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)
! O9 q& R# A3 g* ]) [)
- h+ o; [/ A0 W$ i)
, L4 o2 z6 S# N, C$ Y' E( ^: ?)
- ~! C& k6 Q/ N8 A4 b(defun add_text(pt h ang txt style jus)
9 {, C3 Z$ f" R5 p% H(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)
" d  r& W4 [6 }7 K(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)
% p- K6 ?& ~( k9 ~5 P(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)))
! @5 q! _  M* ^. T1 g3 i" m)
)
6 S4 W% n& a9 l$ `/ n)
$ S* F8 a/ [( z! N; X5 O  q(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
(setq obj (vlax-ename->vla-object ent))
$ E/ w& n! N- b# i5 k# x(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
(cond
; @4 Q0 X- D, H# [7 v" w((= name "3DFACE")
(setq lst (list "【三维面】" laynm))
)
((= name "3DSOLID")
(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
) R' Y3 {4 h+ W' q((= name "ACAD_PROXY_ENTITY")
3 B0 ^5 b) |% `2 [% Q(setq lst (list "【代理】" laynm))
)
((= name "ARC")
(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "圆心角:" (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) "度")
(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
& F/ ^# G  H; q; P/ K% M' ~8 O(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㎡")
6 w/ \. d# F% R  E8 d. \))
. [) A% c$ Q* N* e)
((= name "ATTDEF")
(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "提示:" (vla-get-PromptString obj))
8 a. w, U9 S. J2 @, {. `(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
. l- G' m/ Z) B$ M- b, C(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
! E% O' J! {$ T  X9 ]8 q3 J(strcat "文字样式:" (vla-get-StyleName obj))
))
& f# g+ x: Q  R9 p)
((= name "ATTRIB")
(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "缺省值:" (vla-get-TextString obj))
# q& e  w  E8 x- B: D(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
  `/ `& S; N  x% f8 N& S7 {* @8 v1 ^(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
. d$ _7 O% P! R* o# v; K1 {))
8 ?: K. e/ ]5 Q0 k3 N8 ~/ ~)
1 g" }! [' D# u3 v, b((= name "BODY")
  b! G8 R+ K" G# Z1 j( y! D(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
6 [" t6 e. A, M3 d1 d)
0 v% k" o2 ~( z/ ]- }((= name "CIRCLE")
* \  X. T! H: \: ?0 n# D. f(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
- h% x1 q6 T8 N+ a(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
. z+ S& S8 y/ }  G+ N5 T9 p/ z))
)
((= name "DIMENSION")
: G& T. f. z% O4 y; u( ]# }; O(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
# s/ q7 F' @% @% M' W(strcat "文字样式:" (vla-get-TextStyle obj))
6 M3 t, y- F! K(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
))
  A8 ~# i) a7 i  s0 |( l, L)
1 s/ J: K# |. t2 [4 x((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
! T% z6 e1 }" q0 D- x. a$ _(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
1 ^  d5 d& ~- D(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
, V: B; |# J# I! d' B* W(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
+ |: }3 d1 t8 k% u. D' T1 Q7 ^9 z* ]$ ^))
' @& ^# `% T4 [)
! F7 P# N. ]6 K# M9 Q; L- F3 Y# s) X((= name "HATCH")
+ ]9 s3 ]0 n" \1 v(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
$ r5 n( u9 J2 J5 e* w, t% O6 h% M7 N(strcat "角度:" (rtos (toang (vla-get-PatternAngle obj) 1) 2 1))
  E7 P/ L! S9 A; a; y' G(strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
! T+ F0 A4 e1 R9 r6 ]$ R(strcat "关联:" (if (= (vla-get-AssociativeHatch obj) :vlax-false) "关闭" "打开"))
, C2 L1 D! w2 y(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
. e) t- j3 U1 ?))
)
- B4 _1 |9 ]$ r# X9 j((= name "IMAGE")
(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
3 Y' [, n5 E- J+ K8 f8 I)
  x+ S5 z  l1 a((= name "INSERT")
% o! F0 d0 ^; t, Y(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
! ?7 S0 i) y- {. V8 q(strcat "X比例:" (rtos (dxf ent 41) 2 1))
' t5 }/ I# L+ ^2 t2 F, h4 ~(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) "度")
1 ]; \7 B# y; T))
9 ~  D4 E) Y' e)
% t4 Q6 j2 }- X4 X((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
5 N: f% ?8 A& v0 \2 _))
)
((= name "LINE")
(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
. g8 U3 q& M: j9 R- E+ k(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
& O3 c, r3 q3 w$ {. A7 A))
)
((= name "LWPOLYLINE")
! i9 I9 v6 O0 w(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
, X' l. c% w- z0 p. ?2 v# y4 w(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")

( R; I" b- a5 X6 t& Z                                                           ;;加上一个可以查闭合多段线周长的功能,显示
7 S$ Y. {' F9 j4 J6 s  q, ]                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
+ H+ Q, Y9 e  z6 |$ h# j)
( u6 ?7 H' c% J  K# }((= name "MLINE")
9 M1 d8 D* M2 f(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
3 k5 X& a8 o  N$ Y* J(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
))
)
3 G( H4 }8 ^: I2 v3 k((= name "MTEXT")
6 Y6 c; m# W! \: E( y(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
! V' n! M: P+ c- d(strcat "样式:" (vla-get-StyleName obj))
9 B8 \$ n1 ^9 j) o8 g6 r))
)
# _% j+ _0 _( p# m! f((or (= name "OLEFRAME") (= name "OLE2FRAME"))
(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "POINT")
  {' g& o& M" J7 u* d(setq lst (list "【点】" laynm))
4 z- N: O7 j' [9 I& D6 c)
((= name "POLYLINE")
(setq lst (list "【三维多段线】" laynm))
)
- l" M8 t* H  B, P6 B# N((= name "RAY")
+ t- V. }+ ]2 k& S. W(setq lst (list "【射线】" laynm))
)
- w, H8 l; ~* r/ O: q) D( I((= name "REGION")
(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
( ~* q0 P  V# @, K/ [* M; G)
((= name "SHAPE")
(setq lst (list "【形】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
3 g, S+ R3 X! y(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
8 _# z7 h+ ~* u4 F1 k(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
- h7 h- u( q- D+ m))
: A/ l; ~) _1 q2 C4 Q)
((= name "SOLID")
(setq lst (list "【实体】" laynm))
)
' J4 f- o, e1 H( U. d, C((= name "SPLINE")
(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
" _9 X& O/ C7 Q(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
2 Y/ S" S5 H4 u! C5 F)
((= name "TEXT")
! m' G3 N( w* C: k6 S% K) L(setq lst (list "【文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
* g* q$ M' W- b8 a/ K(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"
"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
))
)
4 T0 ?4 r: U. Z9 p((= name "TOLERANCE")
6 s+ o, }" L+ S" `3 p/ B, W% f! Z0 h' q(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
  G/ A2 \5 w6 R(strcat "文字样式:" (vla-get-TextStyle obj))
7 t3 w7 L% ], C+ Q# x! i(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
3 G% j, M' {( v) }4 ?7 r0 ~))
)
: }  m: ?1 O0 T((= name "TRACE")
  o1 |' E4 D' H0 ~(setq lst (list "【宽线】" laynm))
0 l) Y9 y" ^6 f5 C)
; W7 l0 `* \, ]* v((= name "VERTEX")
(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
& i* Y" n. B( a(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
: W, x: s6 z8 b" D; p(strcat "凸度:" (rtos (dxf ent 42) 2 1))
))
! M- y% ]8 w, C" A; f8 L6 M$ R)
((= name "XLINE")
(setq lst (list "【构造线】" laynm))
)
(T
0 i- B4 |! I/ @) S8 n$ O(setq lst (list "【未知对象】" laynm))
)
9 l  Z+ q' n% Q4 l)
- _% i0 h( l% G' R0 p(setq ss (ssadd) h (/ (getvar "viewsize") 50))
- l4 b# T& n( |4 _3 P(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)
9 x# @- e! }+ u" C, U7 c% L(setq pt (polar pt (car ang) (/ (* n h) 2)))
(if (= (caddr ang) 0)
4 }1 ]9 m7 g4 f* q. u(setq pt (polar pt (/ pi 2) (* 0.4 h)))
6 C0 ?' O. l7 ~(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
)
2 l! [6 ?& x0 Q7 D  x+ F1 [( u(setq n -1)
3 G$ N9 O7 ]9 z8 I4 W/ O& @(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)
7 |( u" c, d9 k2 b: C/ w4 W  \)
% u0 ~! }; N4 u1 S)
(vl-load-com)
(command "_.undo" "_m")
(prompt "\n***移动鼠标掠过对象查看信息！***")
+ ~/ p7 p5 \, j, ~: ~. O(setq olderr *error* *error* myerr)
(setq oldos (getvar "osmode"))
(setq oldfill (getvar "fillmode"))
, N: r3 D. I! W0 _(setvar "osmode" 0)
; U! r8 ~1 g8 r+ J6 |1 e( \(setvar "fillmode" 1)
(setvar "cmdecho" 0)
" h9 [' v" V- ^; e0 h+ ^* z(if (not (tblsearch "style" "宋体"))
* I1 J- [, Q2 R/ C(command "_.style" "宋体" "宋体" "" "" "" "" "")
)
(setq ss (ssadd))
(while (not pd)
(while (not (progn
3 j) d0 G% C' N! V; V: n9 n8 D(setq gr (grread T 1))
(if (= (car gr) 5)
(setq pt (cadr gr)
ent (nentselp pt)
! j" `* @4 w! i5 p( ^6 \ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
(car ent)
)
)
(setq pd T)
# Y, q; P: j# G) x4 ?)
))
4 ^3 r( `$ B+ E2 l, G)
  Y* G( q2 I' r# ]/ ~" j(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
(if entold (redraw entold 4))
9 T- C. j9 k9 u(if ss (command "_.erase" ss ""))
4 j5 E  ?, t# C1 }0 y% I3 Z(redraw ent 3)
(dis ent)
(setq entold ent)
)
)
)
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
(setvar "osmode" oldos)
. V9 ~4 g6 x& T  @7 I4 ?5 T(setvar "fillmode" oldfill)
4 U! N: }% M7 ]% ^1 |  b/ M(setq *error* olderr)
(princ)
* f9 ?2 l- |' v! J6 ?)

十二月

这可以得到任何种类曲线(包括LWPOLYLINE)的总长
) B& B; M: t6 n$ J(vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
希望对你有帮助

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长