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

A云

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

) {, q  S) r/ v+ v, Y! [) T% \

# l4 V3 t; v5 r(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
" a" ~% }# Z( D: A9 z                                                  ；；输入一个实数

: ]  H! Q: l" M(defun myerr(msg)
(setq *error* olderr)
# F" v  G: o+ G( P, k* j(command "_.undo" "_b")
: m$ Y: _; V' a& F2 @(princ)
)
(defun dxf(ent i)
(if (= (type ent) 'ename)
7 w7 v* `% L8 A(setq ent (entget ent))
)
% O8 _: x" }6 G(cdr (assoc i ent))
2 c0 g" M6 b! q" z' ~8 V& f6 [7 }( P)
(defun toang(ang i)
(if (= i 1)
(* ang (/ 180 pi))
/ j: c: u" H3 i(* ang (/ pi 180))
9 w, a+ w. e3 l2 D. W)
)
(defun fx(ang)
(cond
((>= (/ pi 2) ang 0) (list pi (+ pi (/ pi 2)) 1))
$ F0 ]5 e5 D6 G. d((>= pi ang (/ pi 2)) (list 0 (+ pi (/ pi 2)) 1))
((>= (+ pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
; p: T- ?  f, K$ V" R4 _  K((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
; E$ ]& R/ ~  G3 e  C3 S  ])
; T: \* P; l& z)
(defun add_solid(p1 p2 p3 p4)
(entmakex (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 62 1) (cons 100 "AcDbTrace")
4 O1 g+ C9 D) l. p% y' y- X(cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)
, R, {: R, P$ d)
)
)
(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)
(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)))
)
2 B( \1 k2 Q+ m. e* j+ G)
)
(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
2 @6 S9 y9 @8 M! X. Z(setq obj (vlax-ename->vla-object ent))
4 b( t3 W. v: K8 R+ M" B(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
2 W, F' ~6 X9 H/ C% }0 _(cond
((= name "3DFACE")
# F. R1 K8 L! @8 t5 X- [4 m(setq lst (list "【三维面】" laynm))
)
((= name "3DSOLID")
) Z/ `5 ^2 ^# g% u(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
: \; x$ j' b& Q0 l)
$ J5 i) ^) u/ j( R/ j' S* e((= name "ACAD_PROXY_ENTITY")
(setq lst (list "【代理】" laynm))
)
$ C' w9 ~2 f/ w, F$ w((= name "ARC")
' |1 \5 i& m! Y& B0 l  Q; o5 g(setq lst (list "【圆弧】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "圆心角:" (rtos (toang (vla-get-TotalAngle obj) 1) 2 1) "度")
% Z9 h* [% p& T" G* G1 {8 d(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
0 {) P& o7 Q/ `$ b(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
. I9 F1 N  s! @* N(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
6 A  ^$ K4 L: {, \3 e( |  q(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
0 B9 Z2 L, j$ o# o1 ?6 `))
)
((= name "ATTDEF")
8 n- i5 Q# K( c3 n# |; O; Z(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "提示:" (vla-get-PromptString obj))
(strcat "缺省值:" (vla-get-TextString obj))
. ~2 K  i# {- E  `6 D(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
+ g; X- ~$ d* A: h; @))
)
((= name "ATTRIB")
6 M: h' T8 U' P; }9 F(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
7 h: z' q# a' `( y) M  ~5 a( O$ \(strcat "缺省值:" (vla-get-TextString obj))
. B3 b7 m+ Q! U(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
))
)
((= name "BODY")
(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "CIRCLE")
7 I. F/ _+ Y0 U- `5 Q: Q(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㎡")
))
)
! F, C- o$ u5 P; B((= name "DIMENSION")
(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
. E0 w# h. I2 ?! y; M' l8 _6 A(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
0 F/ V2 y3 R( ?))
. i3 n7 I$ n9 t7 S)
  F3 \  A2 ^# U% `4 W2 ^( {((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
2 e* X5 ~' V$ J6 C(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
)
4 z6 g  w- C- L  F. N((= name "HATCH")
+ C0 N6 z' {* Y8 b) e(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
+ h6 n7 }3 g: Q! U4 Z(strcat "角度:" (rtos (toang (vla-get-PatternAngle obj) 1) 2 1))
  P3 b% O7 f" z) V6 s# b  C# k9 B(strcat "比例:" (rtos (vla-get-PatternScale obj) 2 0))
1 ~6 u8 ]% k3 ]5 W% Z(strcat "关联:" (if (= (vla-get-AssociativeHatch obj) :vlax-false) "关闭" "打开"))
- I0 G5 h! {# z; g  K4 I(strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
))
)
((= name "IMAGE")
$ |6 n# W) n; R2 z(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
: v  E. N$ Y, u0 _4 S. ~  g1 j  f)
((= name "INSERT")
(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
8 Z. j, `  z9 \0 y/ Q, ]% j, L(strcat "X比例:" (rtos (dxf ent 41) 2 1))
(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
  I- j4 j+ {+ ~0 [7 z% L(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
))
" w7 @0 o- B* [) _8 q( Q# z)
7 z# ?) F; @. _6 ~# ~/ f% _% f5 v((= name "LEADER")
5 [8 a, D5 n# S) X. A2 B(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
))
)
((= name "LINE")
(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
))
)
" B+ h& r! |* k* Z5 u((= name "LWPOLYLINE")
9 x& e& R* e- Q0 z3 `(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
4 Z6 I/ O  R" t, V(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
" \4 f0 B6 J4 F, X/ _$ U% @, B
5 t: F& B( p. Z% W0 ^9 t                                                           ;;加上一个可以查闭合多段线周长的功能,显示
' p9 ~6 C9 _3 q; p! x1 t6 _                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
)
4 g2 X( s* s# J+ Z. I((= name "MLINE")
(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
2 `  z& c2 k5 z. w(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
$ X' M& K2 O7 L. r, d0 |9 z& c))
% I4 c5 V' `: T- d' Q)
% \* _& o0 j9 x, f% v. L((= name "MTEXT")
(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
' p& C, s% m6 v/ E" x' ](strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
1 H9 U8 O+ I% V$ c% f(strcat "样式:" (vla-get-StyleName obj))
/ F4 j1 V4 `6 l0 h. y$ Q! d))
)
((or (= name "OLEFRAME") (= name "OLE2FRAME"))
(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
! C/ D& `) e- N1 H# E! Z4 p* ?((= name "POINT")
(setq lst (list "【点】" laynm))
)
((= name "POLYLINE")
) L8 {0 a: f1 w4 U9 x& U(setq lst (list "【三维多段线】" laynm))
  V6 M6 C+ z4 p& d1 F)
((= name "RAY")
(setq lst (list "【射线】" laynm))
/ w1 s% m  P& ^- }( p( N* ^6 k)
((= name "REGION")
(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
) v' b6 S! F- S7 E+ o. I* j)
  v7 p- A/ J+ M+ l5 V((= name "SHAPE")
(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) "度")
))
8 c% x! _4 c5 C% B5 M( A4 R)
((= name "SOLID")
; z  A) V( ~# z% n4 Y' I(setq lst (list "【实体】" laynm))
)
/ r$ v, g' n3 G2 N  E4 E((= name "SPLINE")
(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
1 P$ \& ?# L0 B! z(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
)
((= name "TEXT")
0 }4 Z! p5 {8 s! U3 a  Q(setq lst (list "【文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
* i( t" I4 i# d+ O) h(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "样式:" (vla-get-StyleName obj))
6 `. o, Y$ ^" `(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
" _$ B$ J) `+ n6 o( x))
)
' \$ N/ @* J& |+ ?((= name "TOLERANCE")
(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
5 R/ {2 e3 A4 |0 Q) E))
)
((= name "TRACE")
(setq lst (list "【宽线】" laynm))
)
2 D7 o2 H7 Z8 R+ \((= name "VERTEX")
0 h9 |5 b; v& u4 f, c) A(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
$ a- a( C+ _8 J, Q5 s3 S(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
(strcat "凸度:" (rtos (dxf ent 42) 2 1))
' j: @3 v1 X6 z1 P# `))
)
, q4 F: `. |' M; |2 s((= name "XLINE")
(setq lst (list "【构造线】" laynm))
)
# P+ S$ _7 x0 l2 t(T
(setq lst (list "【未知对象】" laynm))
! l8 g0 Z6 m$ j) }" W)
1 k/ q) G, q! a: e& |5 I4 F)
. E; b( x  r* l/ X(setq ss (ssadd) h (/ (getvar "viewsize") 50))
, @2 w( B% v! i, p7 ](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)
( p! C# T  f! o9 V( F; l6 k# A(setq pt (polar pt (car ang) (/ (* n h) 2)))
: H5 V6 `$ S" w" o* Y0 E& B(if (= (caddr ang) 0)
, N7 A9 C, H6 Q" r3 d, N% z(setq pt (polar pt (/ pi 2) (* 0.4 h)))
! q( m- X; @( s* h(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
/ {; @) o: P, k5 p/ U)
2 n6 G! A3 z" e% u  d( T(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)
: L& t' d4 B7 ^7 {' Q)
. G9 k+ S* a# j1 i5 h2 s)
! M2 Q/ [; Y3 r; a$ t: f(vl-load-com)
(command "_.undo" "_m")
6 z" p) _+ x: C1 s! Z# N(prompt "\n***移动鼠标掠过对象查看信息！***")
  I) q- T; g) m/ S# n: `(setq olderr *error* *error* myerr)
(setq oldos (getvar "osmode"))
(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
(setvar "fillmode" 1)
$ T( @6 U% p' a( U' H( |, s$ o& \(setvar "cmdecho" 0)
$ h; S9 u# z, `- u(if (not (tblsearch "style" "宋体"))
(command "_.style" "宋体" "宋体" "" "" "" "" "")
; b( [) c5 h7 E)
(setq ss (ssadd))
# K4 F' r4 ^( }- c( |* p; p(while (not pd)
2 `: O" G* T+ T3 ^9 _2 B- C(while (not (progn
+ l# C) y) ^- H: Z8 f(setq gr (grread T 1))
, a- C. Z' Z6 c6 M3 r6 c  m(if (= (car gr) 5)
(setq pt (cadr gr)
  a1 Z7 I  d- x1 J6 {5 F3 ~0 nent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
* f# v( K" {9 z( W) Y5 ?' R! `: j; c(last (last ent))
' f/ r+ u, g0 z(car ent)
)
)
(setq pd T)
)
))
( q# ?! f' w. c( T7 d. T)
(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
) z, H# W+ y+ f2 h: F! F(redraw ent 3)
( y2 b- V9 ]0 P# l8 e(dis ent)
/ f1 x7 e4 h0 _. a2 K* ?. y7 \(setq entold ent)
)
. I, V. h/ r9 U* o% ^# t$ N)
) y) i$ W; f& A3 G" P' b, `% K5 _1 C3 i, f)
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
(setq *error* olderr)
3 T/ E5 d7 L8 \# X: k4 U  X(princ)
+ q. t3 v7 Q6 N3 l8 _)

十二月

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

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长