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

A云

这是个动态查询的程序，想在里面加上一个可以查闭合多段线周长的功能，显示出周长的长度，还显示一个周长乘以可以输入的一个数的等值，这样方便用来查线割的价钱，有哪位高手可以加上去的请帮帮忙，谢谢了
) A/ B6 ]! w7 \5 J% \
3 d2 n9 U+ [/ w* }% n' {0 a3 Y

( T. y8 @8 N; x. ]# F(defun C:abc(/ myerr dxf toang fx add_solid add_text dis olderr oldos oldfill ss pd gr pt ent entold)
1 h0 U% r0 g# N. H% l                                                  ；；输入一个实数
/ q3 t- c  _) U$ k" L3 q
(defun myerr(msg)
* B6 x2 ?" D6 ?' Y) o(setq *error* olderr)
(command "_.undo" "_b")
(princ)
)
(defun dxf(ent i)
(if (= (type ent) 'ename)
- Z% p  ?4 y6 e, O' z(setq ent (entget ent))
)
(cdr (assoc i ent))
)
. S; b  _+ O/ l(defun toang(ang i)
(if (= i 1)
(* ang (/ 180 pi))
- |4 a* l9 D6 i( D% Q/ N5 W(* ang (/ pi 180))
)
2 Z( f+ n0 y7 z8 w+ f)
(defun fx(ang)
(cond
((>= (/ 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))
8 M2 J  ]4 x/ r- ~((>= (* 2 pi) ang (+ pi (/ pi 2))) (list pi (/ pi 2) 0))
" E: K% I' v! z* e- x7 @)
9 l3 c) @; b2 u! Y9 j; T)
: f" ^* e+ Y% c* X& J( C(defun add_solid(p1 p2 p3 p4)
6 e' G; k/ ]7 G) M8 G, @, y3 L(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)
4 w; D& g1 {6 ~7 Z)
6 ^/ n- _2 M& D8 I! [)
)
$ A$ b# Y/ s5 a% B; ~6 ?& ?$ M(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)
9 j9 y0 Q. n9 {. }(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)))
)
)
4 H; ?  C6 e% f  c2 l- })
(defun dis(ent / obj laynm name st1 st2 st3 lst h ang n)
5 j6 c( P: Z& f1 Z# S& l(setq obj (vlax-ename->vla-object ent))
(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 0))
8 p2 ^) O+ W+ Z4 y& M% v6 a: {7 n(cond
((= name "3DFACE")
+ W& K) }0 U- l+ S4 O(setq lst (list "【三维面】" laynm))
)
((= name "3DSOLID")
7 m& _8 g3 o1 b. N: o7 v" R5 M& I(setq lst (list "【三维实体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "ACAD_PROXY_ENTITY")
8 e  f  I) C  Y(setq lst (list "【代理】" laynm))
. }  |, z9 W9 `1 h0 j8 B)
; k* m) L. G0 E4 x/ e: G((= name "ARC")
% {% s) T  X6 l% H2 U% a(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) "度")
(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
(strcat "总弧长:" (rtos (vla-get-ArcLength obj) 2 3))
& `; m/ \4 _- s: B" a(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 3) "m㎡")
$ j$ K6 L) m, r))
7 g: m" Q6 u- N)
) W4 b' F! o6 r/ O((= name "ATTDEF")
$ }" |7 T( |: z; {9 O8 Z(setq lst (list "【属性定义】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "提示:" (vla-get-PromptString obj))
8 c; h& W6 W- m* l$ ?) R& ~(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
))
3 w5 X9 j2 x. E, U' E9 i# {)
& r2 E% L7 V! ^3 h4 q* `3 z((= name "ATTRIB")
(setq lst (list "【属性】" laynm (strcat "标签:" (vla-get-TagString obj))
(strcat "缺省值:" (vla-get-TextString obj))
(strcat "高度:" (rtos (vla-get-Height obj) 2 0))
8 Z9 e' d% Z/ d3 d( H+ o# f* X1 ?(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "文字样式:" (vla-get-StyleName obj))
# w9 Q3 Y4 h" n) D; M7 ]))
% K3 ^3 j$ N/ \7 u( o/ I)
((= name "BODY")
0 Q/ v: `& N( Z# K(setq lst (list "【体】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
. ?3 `) I5 ~  G3 G' w) G4 w)
((= name "CIRCLE")
  {7 o3 _. x- j( h(setq lst (list "【圆】" laynm (strcat "半径:" (rtos (vla-get-radius obj) 2 0))
(strcat "周长:" (rtos (vla-get-Circumference obj) 2 0))
5 D2 r  P% w& w) N; L- V; Q9 p(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
. B- |$ j2 O3 f- d)
((= name "DIMENSION")
) N, _( C' Q  l; v& }( \7 B( _7 A6 y(setq lst (list "【尺寸标注】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
& M+ ~& v' q) U1 W8 p$ I, Z6 W(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
) b: t- B- ]) J(strcat "替带文字:" (if (= (dxf ent 1) "") "无" (dxf ent 1)))
))
, r( l4 `1 u9 I)
((= name "ELLIPSE")
(setq lst (list "【椭圆】" laynm (strcat "长轴半径:" (rtos (vla-get-MajorRadius obj) 2 0))
! y' q* b- }) g+ _/ z- k7 W(strcat "短轴半径:" (rtos (vla-get-MinorRadius obj) 2 0))
(strcat "起始角:" (rtos (toang (vla-get-StartAngle obj) 1) 2 1) "度")
5 a( R' |3 S4 j9 ]/ t(strcat "终止角:" (rtos (toang (vla-get-EndAngle obj) 1) 2 1) "度")
/ G0 T9 O1 z- E/ o7 T(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
)
((= name "HATCH")
7 u& {/ G# w$ @1 t9 Q0 \# p(setq lst (list "【图案填充】" laynm (strcat "图案名称:" (vla-get-PatternName obj))
  K& a1 D2 F/ H& j1 c(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) "关闭" "打开"))
2 Y, a0 L! P" ](strcat "填充样式:" (nth (vla-get-HatchStyle obj) '("普通" "外部" "忽略")))
6 c1 T  L$ e/ \* O))
)
' I) A4 u6 X* p6 X3 z((= name "IMAGE")
3 l: K7 R( Z2 \8 s7 l* \(setq lst (list "【图像】" laynm (strcat "图像大小:" (rtos (car (dxf ent 13)) 2 0) "X" (rtos (cadr (dxf ent 13)) 2 0))))
1 e2 I  r4 {8 I4 F)
((= name "INSERT")
(setq lst (list "【图块】" laynm (strcat "名称:" (dxf ent 2))
(strcat "X比例:" (rtos (dxf ent 41) 2 1))
(strcat "Y比例:" (rtos (dxf ent 42) 2 1))
# y5 L; q* k) P8 I(strcat "Z比例:" (rtos (dxf ent 43) 2 1))
" d6 Z+ w* L/ g% @0 X. [(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
( k' V) M- n$ O5 M9 ^))
5 a, }- f! b' u8 e% G$ u)
((= name "LEADER")
(setq lst (list "【引线】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "引线类型:" (dxf (list (cons 0 "折线") (cons 1 "样条曲线")) (dxf ent 72)))
))
2 S; j+ V! L5 V; i" _  _)
8 p8 J1 w6 Z9 O((= name "LINE")
5 _4 T% Q0 o: x: \(setq lst (list "【直线】" laynm (strcat "长度:" (rtos (vla-get-length obj) 2 0))
(strcat "角度:" (rtos (toang (vla-get-angle obj) 1) 2 1) "度")
% O5 w  y" [& u$ _3 j  i4 U  ^))
( Z  x8 ?0 z( ~, ?)
((= name "LWPOLYLINE")
3 Z" P. S7 F0 o$ o# Y( S4 C- R( b5 C(setq lst (list "【多段线】" laynm (strcat "常量宽度:" (if (dxf ent 43) (rtos (vla-get-ConstantWidth obj) 2 0) "变宽度"))
* U" x6 o5 U' A0 f; t(strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")

, }7 i" y! ~; v8 g- B; U                                                           ;;加上一个可以查闭合多段线周长的功能,显示
                             ;;周长乘以可以输入的一个数的等值,显示

A云

))
+ C: _7 R  f5 V. m0 Y)
((= name "MLINE")
(setq lst (list "【多线】" laynm (strcat "多线样式:" (vla-get-StyleName obj))
0 l: u% g$ h" A) E* K(strcat "比例因子:" (rtos (dxf ent 40) 2 1))
(strcat "对齐:" (nth (dxf ent 70) '("上" "零" "下")))
))
)
((= name "MTEXT")
(setq lst (list "【多行文字】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
7 I& }2 Y& k  g. x9 `! p(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
(strcat "样式:" (vla-get-StyleName obj))
))
)
/ e; J8 S5 F% I((or (= name "OLEFRAME") (= name "OLE2FRAME"))
(setq lst (list "【OLE边框】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
: u+ d1 g# d, ~* R$ A/ i((= name "POINT")
(setq lst (list "【点】" laynm))
" `9 T3 H0 t' R3 b" @6 K4 y)
5 `9 O5 z3 e0 w8 O. }& j((= name "POLYLINE")
(setq lst (list "【三维多段线】" laynm))
)
8 z1 F: }8 |6 M2 L, m((= name "RAY")
- u# H' H; X, h# F3 l(setq lst (list "【射线】" laynm))
" n" d' _+ _  ^$ ?  E# {)
0 |+ \0 |5 d$ T* n((= name "REGION")
8 F5 b  _9 Y+ A- S( w(setq lst (list "【面域】" laynm (strcat "格式版本号:" (itoa (dxf ent 70)))))
)
((= name "SHAPE")
( S# u4 L2 b/ _+ g; o$ c8 n$ F(setq lst (list "【形】" laynm (strcat "高度:" (rtos (vla-get-Height obj) 2 0))
# Y- V. J$ A8 l(strcat "宽度系数:" (rtos (vla-get-ScaleFactor obj) 2 1))
, c$ y" a3 M% k4 T1 d; H' P) z(strcat "角度:" (rtos (toang (vla-get-Rotation obj) 1) 2 1) "度")
  l+ \' z0 v* P$ F/ C; H9 S))
; u+ t$ K. s8 S* s)
((= name "SOLID")
(setq lst (list "【实体】" laynm))
6 Z7 t7 y9 A# }; x)
((= name "SPLINE")
(setq lst (list "【样条曲线】" laynm (strcat "多段线:" (if (= (vla-get-Closed obj) :vlax-false) "不闭合" "闭合"))
(strcat "阶数:" (rtos (vla-get-Degree obj) 2 0))
(strcat "面积:" (rtos (/ (vla-get-Area obj) 1) 2 2) "m㎡")
))
)
((= 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- D6 [. Z6 A" n5 `- h6 ^! c(strcat "对齐:" (nth (vla-get-Alignment obj) '("Left" "Center" "Right" "Aligned" "Middle" "Fit" "TopLeft" "TopCenter" "TopRight"
"MiddleLeft" "MiddleCenter" "MiddleRight" "BottomLeft" "BottomCenter" "BottomRight")))
2 K6 X  D" u% f' |))
)
((= name "TOLERANCE")
2 |$ S( p; L4 Z1 c(setq lst (list "【公差】" laynm (strcat "标注样式:" (vla-get-StyleName obj))
(strcat "文字样式:" (vla-get-TextStyle obj))
(strcat "文字高度:" (rtos (vla-get-TextHeight obj) 2 1))
))
)
((= name "TRACE")
(setq lst (list "【宽线】" laynm))
)
((= name "VERTEX")
2 d- _0 ]! e9 g. @(setq lst (list "【顶点】" laynm (strcat "起始宽度:" (rtos (dxf ent 40) 2 0))
4 W, K( [; O# J: w; j  J(strcat "结束宽度:" (rtos (dxf ent 41) 2 0))
( }/ E! H0 p7 P/ @+ g% W5 s(strcat "凸度:" (rtos (dxf ent 42) 2 1))
))
: N& _/ e* `3 h)
3 t4 e( _+ z; ^((= name "XLINE")
(setq lst (list "【构造线】" laynm))
3 @; ?# \+ M6 Z* s; D& V)
(T
3 E" M- |' g3 \) L; f(setq lst (list "【未知对象】" laynm))
  S! N# g. X4 a4 k' U+ O& P, M- y)
0 n) g! A. G0 M1 m7 Y)
+ E# C& V6 w! p& [3 Q(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))))
8 b9 Q4 H5 l8 X! O(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)
5 s. K  ~3 K  R7 \+ a3 |(setq pt (polar pt (car ang) (/ (* n h) 2)))
# P" J3 d  u. `2 N+ e(if (= (caddr ang) 0)
9 }" G" z: X8 D! e* ^6 W(setq pt (polar pt (/ pi 2) (* 0.4 h)))
(setq pt (polar pt (/ pi 2) (+ (* 1.4 h) (* 1.8 h (length lst)))))
; e) S$ [9 e- U1 H9 V7 d* g1 W5 C)
(setq n -1)
, j) x( T9 a& a2 \3 E(repeat (length lst)
1 L/ |& Z) O* K- S2 Q(ssadd (add_text (setq pt (polar pt (+ pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (1+ n)) lst) "宋体" 1) ss)
)
)
+ F8 c' ^6 W% P0 k% f4 k+ ~(vl-load-com)
/ u& r5 X% g" l(command "_.undo" "_m")
" J6 {6 M4 Z0 b, u! H, K, B(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error* *error* myerr)
(setq oldos (getvar "osmode"))
(setq oldfill (getvar "fillmode"))
" T8 [" E8 O9 I( N- v; Y3 j  n(setvar "osmode" 0)
(setvar "fillmode" 1)
(setvar "cmdecho" 0)
(if (not (tblsearch "style" "宋体"))
! Z/ b1 ~, Z  i8 [: h/ w(command "_.style" "宋体" "宋体" "" "" "" "" "")
: Y/ Z( {* ~# k, y2 ]: q( [& ^4 x3 ?)
9 Q3 g3 ^1 z2 [& N- v" U4 z(setq ss (ssadd))
(while (not pd)
0 [" }) F/ p* T) t/ z' h(while (not (progn
8 M! x5 V2 ^7 j. C0 H! [(setq gr (grread T 1))
(if (= (car gr) 5)
& t# s8 R# }: x3 b(setq pt (cadr gr)
% K, y( T9 f2 y# ^7 Q: |ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
5 M8 S) F* }3 t  _  y3 N(last (last ent))
(car ent)
+ D1 h/ s# ^5 e# `, g)
* D! P, `9 T4 M: P1 B( w  c/ `)
7 `9 r* D5 x; [, c+ i4 Q(setq pd T)
)
))
; u5 I4 b6 M- I0 a7 N+ ], ?) x3 z)
( ?# e! A7 ]" N0 t# R(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
& S) h& [# i- F8 s(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
4 b- {2 \; V  p. A6 q- h& a7 J" S6 @(redraw ent 3)
(dis ent)
) G- Y5 r5 A2 J, n7 f3 k! C(setq entold ent)
)
)
)
0 f9 ^0 m) |' W* K( x/ M9 k0 j(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
2 x6 H# S- y- j! Z8 I& E(setvar "osmode" oldos)
) t' y% y  S& k( X8 G* K- W7 T(setvar "fillmode" oldfill)
; s# W* e: j: L9 A/ q% x6 \" K. V(setq *error* olderr)
(princ)
  r, B# B' l2 D4 E0 P/ f)

十二月

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

A云

谢谢楼上 帮助

A云

好像得不到椭圆的周长