（更新）[分享]：一个用于面积统计的小程序。

eachy

正在做一个项目，要统计一个个的小地块面积，于是就写了这个程序，先把地块面积赋值到标识文字上，最后统计到表格。

2. 
   
3. ((defun c:xdtb_ptarea (/ pt pts area e)
   
4.   (while (setq pt (getpoint "\nPoint: "))
   
5.     (if        (= (type pt) 'LIST)
   
6.       (setq pts (cons pt pts))
   
7.     )
   
8.   )
   
9.   (if pts
   
10.     (progn
    
11.       (xdrx_begin)
    
12.       (xdrx_sysvar_push "osmode" "dimzin")
    
13.       (setvar "dimzin" 0)
    
14.       (setq area (abs (apply 'xdrx_parea pts)))
    
15.       (setq e (xdrx_entsel "\n拾取标注文字: " '((0 . "text"))))
    
16.       (xdrx_setenttodb (car e))
    
17.       (xdrx_setxdata "area" (rtos area 2 1))
    
18.       (princ (strcat "\nArea = " (rtos area 2 1)))
    
19.       (xdrx_sysvar_pop)
    
20.       (xdrx_end)
    
21.     )
    
22.   )
    
23.   (princ)
    
24. )
    
25. (defun c:xdtb_tjarea (/ e ss lay str area pt)
    
26.   (setq e (xdrx_entsel "\n拾取典型文字: " '((-3 ("AREA")))))
    
27.   (if e
    
28.     (progn
    
29.       (xdrx_begin)
    
30.       (xdrx_sysvar_push "osmode")
    
31.       (setvar "osmode" 0)
    
32.       (xdrx_setenttodb (car e))
    
33.       (setq lay (xdrx_getentdxf 8))
    
34.       (princ "\n拾取统计范围(回车全选)...")
    
35.       (if (not (setq ss (ssget (list (cons 8 lay) '(-3 ("area"))))))
    
36.         (setq ss
    
37.                (ssget "x" (list (cons 8 lay) '(-3 ("area"))))
    
38.         )
    
39.       )
    
40.       (if ss
    
41.         (progn
    
42.           (setq pt (getpoint "\n输出点: "))
    
43.           (xdrx_setsstodb ss 0)
    
44.           (while (setq e1 (xdrx_getentdata 0))
    
45.             (setq str  (xdrx_getentdxf 1)
    
46.                   area (car (xdrx_getxdata e1 "area"))
    
47.             )
    
48.             (vl-cmdf ".text" pt 1.6 "0" (strcat str "    " area))
    
49.             (setq pt (polar pt (- _pi2) 6.))
    
50.           )
    
51.         )
    
52.       )
    
53.       (xdrx_sysvar_pop)
    
54.       (xdrx_end)
    
55.       (princ)
    
56.     )
    
57.   )
    
58. )
    

<br /> ((defun c:xdtb_ptarea (/ pt pts area e)<br />   (while (setq pt (getpoint "\nPoint: "))<br />     (if        (= (type pt) 'LIST)<br />       (setq pts (cons pt pts))<br />     )<br />   )<br />   (if pts<br />     (progn<br />       (xdrx_begin)<br />       (xdrx_sysvar_push "osmode" "dimzin")<br />       (setvar "dimzin" 0)<br />       (setq area (abs (apply 'xdrx_parea pts)))<br />       (setq e (xdrx_entsel "\n拾取标注文字: " '((0 . "text"))))<br />       (xdrx_setenttodb (car e))<br />       (xdrx_setxdata "area" (rtos area 2 1))<br />       (princ (strcat "\nArea = " (rtos area 2 1)))<br />       (xdrx_sysvar_pop)<br />       (xdrx_end)<br />     )<br />   )<br />   (princ)<br /> )<br /> (defun c:xdtb_tjarea (/ e ss lay str area pt)<br />   (setq e (xdrx_entsel "\n拾取典型文字: " '((-3 ("AREA")))))<br />   (if e<br />     (progn<br />       (xdrx_begin)<br />       (xdrx_sysvar_push "osmode")<br />       (setvar "osmode" 0)<br />       (xdrx_setenttodb (car e))<br />       (setq lay (xdrx_getentdxf 8))<br />       (princ "\n拾取统计范围(回车全选)...")<br />       (if (not (setq ss (ssget (list (cons 8 lay) '(-3 ("area"))))))<br />         (setq ss<br />                (ssget "x" (list (cons 8 lay) '(-3 ("area"))))<br />         )<br />       )<br />       (if ss<br />         (progn<br />           (setq pt (getpoint "\n输出点: "))<br />           (xdrx_setsstodb ss 0)<br />           (while (setq e1 (xdrx_getentdata 0))<br />             (setq str  (xdrx_getentdxf 1)<br />                   area (car (xdrx_getxdata e1 "area"))<br />             )<br />             (vl-cmdf ".text" pt 1.6 "0" (strcat str "    " area))<br />             (setq pt (polar pt (- _pi2) 6.))<br />           )<br />         )<br />       )<br />       (xdrx_sysvar_pop)<br />       (xdrx_end)<br />       (princ)<br />     )<br />   )<br /> )<br />

xforce

楼主不好意思，新手，这个怎么用啊

bluejan

对啊，都不知道怎么用

3602705

来个演示吧

zhouweineng

来个演示吧

HUKAI

有用吗？？？

wyd

楼主，可以说明的更详细吗？

xiaofang08

能否将它改成自动求相同填充图形范围的总面积?

hs_f

先选取要统计的填充图形，然后“填充面积”，总面积就出来乐。

萧山

还是麻烦，CAD自带的填充也显示面积呀

xiaofang08

怎样加载，输入什么命令才能使用？

gdqbx

不能加载。cad2004。提示表格错误。

onew

不会用，

*小绿*

怎么用啊

清风浪子

能不能说一下如何用呀,我可是新手呀