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

A云

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

- i0 f1 X0 R$ N8 s( O
* C& E/ q2 A+ t+ f) Y' Y
( y' T4 _3 M: |5 i$ X(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
                                                  ；；输入一个实数

+ {7 p: r' i5 g& {, y0 q2 q(defun myerr(msg)
* {/ ?0 i; e1 q9 v0 W(setq *error* olderr)
(command "_.undo" "_b")
5 Z4 Z) f; l+ t5 _(princ)
)
(defun dxf(ent i)
* i7 Y5 p' h( Z( \* k(if (= (type ent) 'ename)
(setq ent (entget ent))
)
(cdr (assoc i ent))
)
(defun toang(ang i)
(if (= i 1)
(* ang (/ 180 pi))
1 }' ^. _( e, ?: l. N3 T9 p(* ang (/ pi 180))
)
0 L" D2 V* H/ d# @' m)
(defun fx(ang)
" c4 D% c+ d, N  O(cond
((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
. r1 [' h0 Y( t" b((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
)
)
(defun add_solid(p1 p2 p3 p4)
(entmakex (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 62 1) (cons 100 "AcDbTrace")
3 k# \) o) d2 w( o. c0 X- ?4 j(cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)
' A- V5 q* |8 ~! z2 T" ~)
)
)
(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)
4 ^4 ~' s4 X# X(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)))
4 Z! D+ F8 h+ L6 p8 x: F1 M)
  U. u$ y0 Z  \0 w" c( Y)
)
6 E/ T  r5 Z1 H( 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))
/ ]7 j" d$ A% v  P(cond
((= name "3DFACE")
* F7 g$ }. v8 _7 J# M+ Z(setq lst (list "【三维面】" laynm))
)
((= name "3DSOLID")
0 I) s' K( O4 \* A( q(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
0 w. D! `& ~: Q1 p# W)
# E7 Y5 u* V8 }((= name "ACAD_PROXY_ENTITY")
(setq lst (list "【代理】" laynm))
)
! Q$ x0 s( Q( D  l$ Q4 l8 A% r((= name "ARC")
. l5 S: m$ ?4 n, K- f(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "圆心角:" (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) "度")
9 E1 j% S9 N) |* f(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
1 W3 o0 c) P5 h+ z; X/ |3 V(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
% P3 [+ F  w* y7 N3 G4 ^))
)
((= name "ATTDEF")
(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
8 }% \2 T$ z7 x% Q; P(strcat "提示:" (vla-get-PromptString obj))
- w* t; a3 i! N: G: u+ z(strcat "缺省值:" (vla-get-TextString obj))
& a: d! l$ c& ^(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
6 c3 o! P- I& c1 p$ F2 }, G(strcat "文字样式:" (vla-get-StyleName obj))
))
)
$ d! ]3 V' j& L/ R" I2 g6 D& z((= name "ATTRIB")
1 M4 T' X& c2 m7 t2 z" B- U6 ?(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
' c0 d! @; m& A' O% y0 D. q3 n6 T(strcat "缺省值:" (vla-get-TextString obj))
8 D% d0 f) J% f* h! Y(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
/ `9 U7 O6 b3 a5 w. y(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
! Z# N6 J  ]' r0 F6 [8 ]2 M))
; N- q; Y, k  y6 G, G)
* r2 c( A9 Y9 g) I((= name "BODY")
(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "CIRCLE")
1 S* `( w8 V: R- H+ t- E- c(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
% O' T7 L$ J5 E: h' K* L(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
1 P; {+ z, g2 B) q))
# ?2 t6 G: E/ {( `& })
((= name "DIMENSION")
(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
* R; q, g) c  q; N(strcat "文字样式:" (vla-get-TextStyle obj))
, D% H8 Y( v6 M(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
* M5 d- I& I1 J+ x(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
# J5 P/ R2 W2 v- q7 ^8 W))
' v' g; h* n/ J4 b! x)
1 j) F. Y$ @* b0 B& }8 O. m((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
( _5 O4 _, J# Z0 p* G" G  w4 c$ P, d(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
' ?4 F1 L# L* i2 C5 r: n(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
$ o4 r' o, W" A. b2 Y))
)
((= name "HATCH")
(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
* d# s/ i4 b. I8 |" o(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) "关闭" "打开"))
(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
))
)
((= name "IMAGE")
(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
' j$ N, [9 F1 Z) F7 l$ @1 A# p)
((= name "INSERT")
(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
' G, O! L7 u) s9 t/ `$ J(strcat "X比例:" (rtos (dxf ent 41) 2 1))
(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
/ ?: }0 }3 J) T( N(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
0 N7 F4 g) }2 b)
. s# y/ m" W/ F9 r0 c((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
- r& I0 }8 l9 D3 b( y. s; J3 U(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
$ Y5 D- F! W; o% o8 p))
)
5 @+ h3 \, C4 ]4 L3 S; ]$ {((= name "LINE")
; k# a$ s& E% x/ w(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
))
)
4 v% G6 P/ J: S4 t) l8 g! V& I((= name "LWPOLYLINE")
. f# M, ?0 g9 @) p  D8 e0 h) Y(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
' }: D+ |1 I* B- n$ H) U/ N(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
: g" r3 b; o# R. p
                                                           ;;加上一个可以查闭合多段线周长的功能,显示
                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
)
+ q% t7 d" A# @6 x6 o7 d((= name "MLINE")
(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
0 N  m/ _* s( v0 `& g: |(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
  A$ V4 R: n: a/ {% e))
)
3 Z1 r$ |2 B/ j( Z( `  e1 h((= name "MTEXT")
' y5 @: N# R. y(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
; I/ P: e' w. r% U(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
) k" K* ^5 _0 S% x( \7 v! D(strcat "样式:" (vla-get-StyleName obj))
: X) I0 V. g; Y. i! t* k# G))
  q3 k! c* `! T, Z" Q; F- T)
((or (= name "OLEFRAME") (= name "OLE2FRAME"))
3 e* C+ f2 q6 c4 G5 P1 v5 i(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
3 P  j4 R0 h; @$ w)
) d) k; K  f: Q4 ~* Q1 O+ d6 J((= name "POINT")
(setq lst (list "【点】" laynm))
)
" J2 _* d3 Y4 g) z2 d8 Z! U. K9 \8 a((= name "POLYLINE")
(setq lst (list "【三维多段线】" laynm))
( a# F6 F1 y' b. G" x1 U)
3 |8 @2 c0 @( G3 @1 T+ k((= name "RAY")
(setq lst (list "【射线】" laynm))
2 O7 t( i2 o% @7 _9 \% x' g, u$ r)
((= name "REGION")
(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
2 x4 w+ p1 U3 B, ]# r7 s' U)
  _  M7 C: b6 C' |((= name "SHAPE")
(setq lst (list "【形】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
6 q  ]: e4 M+ `(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
1 _5 s! m, o/ N))
)
((= name "SOLID")
4 e: h6 y2 E& a: b(setq lst (list "【实体】" laynm))
  A5 b1 g, b( A6 k6 w7 y& R)
- g' r8 V6 X" @((= name "SPLINE")
(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
/ d9 U  T8 N8 e9 w(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
! F$ {4 g% J1 R+ u6 f))
)
((= name "TEXT")
! }- g1 E& M+ o4 ?6 k# P( M(setq lst (list "【文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
- t, S! ~& S8 g9 j1 l(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
* W, Z+ p! e8 s/ L5 v(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")))
7 q5 O  s% V( b  ?" A: M5 q& A))
)
((= name "TOLERANCE")
/ D6 F3 X1 a+ ]! `2 X' p(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
3 S, @! G0 A. ?4 C* Q/ i8 A(strcat "文字样式:" (vla-get-TextStyle obj))
/ o! c7 T; o' M+ z6 }' j(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
))
)
8 U8 m) a- k, ^. S((= name "TRACE")
' k" O8 Y$ X; B8 S1 j(setq lst (list "【宽线】" laynm))
)
((= name "VERTEX")
(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
; `  x0 k; w; G(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
(strcat "凸度:" (rtos (dxf ent 42) 2 1))
))
) C4 W) W- x/ ^0 k& \* ^. d)
((= name "XLINE")
(setq lst (list "【构造线】" laynm))
6 v' J2 t" Z4 v! b- j5 Z1 t)
(T
  ?* \  r; R' ?0 s, d3 f3 E; E, |(setq lst (list "【未知对象】" laynm))
( n( u" i) H+ U2 G1 c- v)
)
. `9 V- `5 {1 _) I, a(setq ss (ssadd) h (/ (getvar "viewsize") 50))
(setq ang (fx (angle (getvar "viewctr") pt)))
+ q9 Z% R4 K# E& `* s7 Q(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)))
(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
)
(setq n -1)
(repeat (length lst)
# T) J: [. I& D1 l  N(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
0 G4 F! p, W* f% x! h2 w7 ~, f)
)
(vl-load-com)
# c5 [# f" u, T$ e(command "_.undo" "_m")
9 }: Q! r& K. J9 M(prompt "\n***移动鼠标掠过对象查看信息！***")
% N& U4 ]- q- U4 @! s' F' u+ d0 ^(setq olderr *error* *error* myerr)
(setq oldos (getvar "osmode"))
(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
(setvar "fillmode" 1)
(setvar "cmdecho" 0)
(if (not (tblsearch "style" "宋体"))
(command "_.style" "宋体" "宋体" "" "" "" "" "")
)
) W! L! M$ e) R- Y(setq ss (ssadd))
(while (not pd)
(while (not (progn
(setq gr (grread T 1))
4 a' b* ^, j8 @2 B0 u+ k(if (= (car gr) 5)
(setq pt (cadr gr)
ent (nentselp pt)
3 S% R0 E1 I' l+ V! cent (if (and ent (= (type (last (last ent))) 'ename))
8 R/ A# @% a; o(last (last ent))
3 K$ I9 n9 B. K(car ent)
2 C6 b: [$ K" n+ F+ x6 U2 F)
)
(setq pd T)
% S3 O/ k: D" B5 K)
))
8 s' P4 {- t0 L6 I3 [4 R)
(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
: Z# X% L7 h( {* }& C5 M8 |2 M$ U1 O(redraw ent 3)
3 H' W  j) R% v(dis ent)
- r- K( w+ ]1 n' b. U, z(setq entold ent)
)
)
8 F  j2 ^$ e2 o; z! t5 D)
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
; Z5 E. d" u' V  v(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
) c  E; Z: P2 X# m' U; m(setq *error* olderr)
7 |6 @- [. v& f" H+ l(princ)
( g) K5 l1 v2 y' _! G  H/ D% ~; R)

十二月

这可以得到任何种类曲线(包括LWPOLYLINE)的总长
6 B9 U% g* w: |% L(vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
希望对你有帮助

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长