求算面积的程序

雷鸟

我用area算面积，但我习惯用毫米为单位画图，所以area算出的面积就带了很多零（因为它的单位是平方毫米），我希望我用毫米为单位画图，用area算出的面积是以平方米为单位，这样area得出的数据就不会带这么多零了，就不会把人搞晕了！

XDSoft

2. 
   
3. 
   
4. (defun c:rarea()
   
5.    (prompt (strcat "面积是:" (rtos (/ (getvar "area") 1e6) 2 1)))
   
6.    (princ)
   
7. )
   
8. 
   

<br /> <br /> (defun c:rarea()<br />    (prompt (strcat "面积是:" (rtos (/ (getvar "area") 1e6) 2 1)))<br />    (princ)<br /> )<br /> <br />

雷鸟

现在好了，但还是有点麻烦，就是要先用area，再用rarea一次才能得到希望的结果，如果两个命令可以合并的话，就完美了！
:1

XDSoft

最初由 雷鸟 发布
[B]现在好了，但还是有点麻烦，就是要先用area，再用rarea一次才能得到希望的结果，如果两个命令可以合并的话，就完美了！
:1 [/B]

再试试

2. 
   
3. 
   
4. (defun c:rarea()
   
5.    (prompt "\n开始计算面积，请点取第一点:")
   
6.    (command "area")
   
7.    (while (/= (getvar "cmdactive") 0)
   
8.       (command pause)
   
9.       (prompt "\n下一点<结束>:")
   
10.    )   
    
11.    (prompt (strcat "\n面积是:" (rtos (/ (getvar "area") 1e6) 2 1)))
    
12.    (princ)
    
13. )
    

<br /> <br /> (defun c:rarea()<br />    (prompt "\n开始计算面积，请点取第一点:")<br />    (command "area")<br />    (while (/= (getvar "cmdactive") 0)<br />       (command pause)<br />       (prompt "\n下一点<结束>:")<br />    )   <br />    (prompt (strcat "\n面积是:" (rtos (/ (getvar "area") 1e6) 2 1)))<br />    (princ)<br /> )<br />

雷鸟

太完美了！
:1:1:1

梦断江南

aat-逐选面积标注;aad-多选面积标注-------lxx2001.2m
;上标-%%132%%133
;;;适用的实体：POLYLINE;LWPOLYLINE;CIRCLE;REGION;3DSOLID
;;;不适用的实体：POLYLINE(3维曲面)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;aat逐选面积标注
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN Cat (/ txth sc t key aa p1 p2 pt1)
(princ "\naad逐选面积标注--------lxx.2001.2m")
(if (null(setq txth(getdist "\n字高<300>:")))(setq txth 300));缺省字高300
(if (null(setq sc (getdist "\n标注单位换算1=<1000>mm:")))(setq sc 1000))
(setq t "true")
(while t
(setq key (getstring "\neXit-X/点取区域点-A/<选封闭实体>:"))
(cond
((or(= key "x")(= key "X"))(setq t nil));xX
((= key "")；<>---enter;mouse(right botton)
(progn
(while (setq ent(car(entsel)))
(command "area" "o" ent "")
(setq aa (getvar "area"))
(bz)
)))
((or(= key "a")(= key "A"));;;aA
(progn
(while (setq p1 (getpoint"\n第一点："))
(command "area" p1)
(while (setq p2(getpoint "\n下一点："))
(command p2)
)
(command "")
(setq aa (getvar "area"))
(bz)
))));;;cond
)(princ);;;while
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;aad多选面积标注
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cad (/ txth sc key ss i aa ent pt1)
(princ "\naad-多选面积标注-------lxx2001.2m")
(if (null(setq txth(getdist "\n字高<300>:")))(setq txth 300));缺省字高300
(if (null(setq sc (getdist "\n标注单位换算1=<1000>mm:")))(setq sc 1000))
(setq key (getstring "\n面积求和-A/<分别标注面积>:"))
(princ "\n选封闭实体集ss:")
(setq ss (ssget) i 0)
(cond
((or(= key "a")(= key "A"))；aA
(progn
(command "area" "a" "o")
(repeat (sslength ss)
(setq ent (ssname ss i))
(command ent)
(setq i (+ 1 i))
)
(command "" "")
(setq aa (getvar "area"))
(bz)
)
)
((= key "")；<>---enter;mouse(right botton)
(progn
(repeat (sslength ss)
(setq ent(ssname ss i))
(command "area" "o" ent)
(setq aa (getvar "area") i (+ 1 i))
(redraw ent 3)
(bz)(redraw ent 4)
)
)
) );cond
(princ "\n标注完成!")(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;(通)标注面积----bz
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun bz()
(setq aa (/ aa (* sc sc)))
(setq pt1 (getpoint "\n标注点:"))
(command "text" "J" "c" pt1 txth "0" (strcat (rtos aa 2 3) "M" "%%132"))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ "\naat-逐选面积标注;aad-多选面积标注-------lxx2001.2m")(princ)

eachy

试试这个,http://www.fspdi.com/forum/showthread.php?s=&threadid=1038

雷鸟

谢谢各位！
:1:1:1