测量封闭区域面积(2种方法)
zml1984
zml1984 Lv.3
2009年09月08日 17:08:47
只看楼主

[code](setvar "CMDECHO" 0)(vl-load-com);;;=================================================================*;;;功能:测量封闭区域的面积(可分别设置XY比例) *;;;日期:zml84 于 2009-06-07 *(defun C:TT (/ X Y SIZE SS AREA STR TMP)

[code](setvar "CMDECHO" 0)
(vl-load-com)
;;;=================================================================*
;;;功能:测量封闭区域的面积(可分别设置XY比例) *
;;;日期:zml84 于 2009-06-07 *
(defun C:TT (/ X Y SIZE SS AREA STR TMP)
;; 0 初始化
(or *TEST_TMP*
(setq *TEST_TMP* '(1000 100 2.5))
)
(setq X (nth 0 *TEST_TMP*)
Y (nth 1 *TEST_TMP*)
SIZE (nth 2 *TEST_TMP*)
)

;; 1
(while
(progn
(princ
(strcat
"\n当前设置:X比例="
(rtos X)
",X比例="
(rtos Y)
",字高="
(rtos SIZE)
)
)
(initget "X Y Size")
(princ
"\n点取要测量面积的封闭对象,或 [X比例(X)/Y比例(Y)/字高(S)]: "
)
(setq SS (entsel ""))
)
(cond ((= SS "X")
(if (and (setq TMP (getreal "\n设置X向比例: "))
(> TMP 0)
)
(setq X TMP)
)
)
((= SS "Y")
(if (and (setq TMP (getreal "\n设置Y向比例: "))
(> TMP 0)
)
(setq Y TMP)
)
)
((= SS "Size")
(if (and (setq TMP (getreal "\n设置字体高度: "))
(> TMP 0)
)
(setq SIZE TMP)
)
)
((and (setq
AREA (vla-get-area
(vlax-ename->vla-object (car SS))
)
)
(setq AREA (/ AREA 1.0 X Y)
STR (rtos AREA 2 3)
)
(princ (strcat "\n**面积 = " STR))
(setq PT (getpoint "\n文字的位置: "))
)
(command "_.TEXT" "non" PT SIZE 0 STR)
)
)

)

;; 2
(setq *TEST_TMP* (list X Y SIZE))
(princ)

)






;;;=================================================================*
;;;功能:点取内部一点,测量封闭区域的面积(可分别设置XY比例) *
;;;日期:zml84 于 2009-06-07 *
(defun C:TT2 (/ X Y SIZE PT EN AREA STR TMP)
;; 0 初始化
(or *TEST_TMP*
(setq *TEST_TMP* '(1000 100 2.5))
)
(setq X (nth 0 *TEST_TMP*)
Y (nth 1 *TEST_TMP*)
SIZE (nth 2 *TEST_TMP*)
)

;; 1
(while
(progn
(princ
(strcat
"\n当前设置:X比例="
(rtos X)
",X比例="
(rtos Y)
",字高="
(rtos SIZE)
)
)
(initget "X Y Size")
(princ
"\n点取要测量的位置,或 [X比例(X)/Y比例(Y)/字高(S)]: "
)
(setq PT (getpoint ""))
)
(cond ((= PT "X")
(if (and (setq TMP (getreal "\n设置X向比例: "))
(> TMP 0)
)
(setq X TMP)
)
)
((= PT "Y")
(if (and (setq TMP (getreal "\n设置Y向比例: "))
(> TMP 0)
)
(setq Y TMP)
)
)
((= PT "Size")
(if (and (setq TMP (getreal "\n设置字体高度: "))
(> TMP 0)
)
(setq SIZE TMP)
)
)
((and
(setq EN (bpoly PT))
(setq
AREA (vla-get-area
(vlax-ename->vla-object EN)
)
)
;;(progn (command "REGEN") (redraw EN 3) t)
(entdel EN)

(setq AREA (/ AREA 1.0 X Y)
STR (rtos AREA 2 3)
)
(princ (strcat "\n**面积 = " STR))
)
(command "_.TEXT" "non" PT SIZE 0 STR)
)
)

)

;; 2
(setq *TEST_TMP* (list X Y SIZE))

(princ)
)[/code]
免费打赏
scrons
2009年09月10日 17:52:38
2楼
收下了,慢慢研究。。呵呵
回复
cyw2626
2009年09月18日 21:33:36
3楼
收下了,慢慢研究!!!!!!!!!
回复
love_parents
2009年12月03日 23:29:05
4楼
收下了,慢慢研究,不过lsp初学
回复
tensiweb
2009年12月07日 10:11:31
5楼
支持,非常好,学习一下!!!!
回复
xlh01818
2009年12月07日 12:44:10
6楼
好程序!下来学习学习。非常感谢楼主的无私奉献!
顶!!!!!!
回复
kooby.w
2009年12月08日 22:13:52
7楼
学习中:victory: :victory:
回复
lcy970128-1
2009年12月10日 16:52:13
8楼
支持,lisp还是不错的开发程序!!!!!!!!!!!:victory: :victory: :victory:
回复
nydiass
2010年02月27日 04:02:03
9楼
請問如果要測量封閉區域周長的話,可以怎麼改?
謝謝:)
回复
施工cad
2010年03月21日 11:00:59
10楼
楼主的程序非常好:call:
你是我们学习的样板:kiss:
你的源码开放精神,将为中国工程师事业的发展,
奠定不可磨灭的丰碑:hug:
:time:

[ 本帖最后由 rq28 于 2010-3-21 11:02 编辑 ]
回复
sdt2468
2010年08月12日 18:07:34
11楼
支持!!!!
非常好!
学习了!
回复

相关推荐

APP内打开