[原创]：如图示的两条多义线，如何得到两者之间的面积

god

如图示的两条多义线，如何得到两者之间的面积，用area要点击每个交点才能得出，比较麻烦，如用选对象方式只能选一个就计算结束，因为我要算很多这种情况下的面积，能不能只点中间一个点，即可算出包围的面积呢？或者有其他的省时方法？

yxc

先作封闭边界（-bo），再求面积可以吗

god

这个方法不错，
要是有段lsp代码就好了，一气呵成，最后把新建的边界也删掉。

eachy

最初由 god 发布
[B]如图示的两条多义线，如何得到两者之间的面积，用area要点击每个交点才能得出，比较麻烦，如用选对象方式只能选一个就计算结束，因为我要算很多这种情况下的面积，能不能只点中间一个点，即可算出包围的面积呢？或者... [/B]

刚开始用API时写的，应该还能用。

2. 
   
3. ;|
   
4. 命令：Plarea
   
5. 
   
6. 功能：计算封闭曲线（*polyline,spline,circle,ellipse)面积并标注
   
7. 
   
8. 说明：用于统计曲线面积，包括三种方式：
   
9.       1. boundary方式，拾取点，如果生成边界则标面积
   
10.       2. 统计图层曲线面积
    
11.       3. 选择范围后标注所有曲线积   
    
12. 
    
13.       程序中标注数字采用了临时图层tmp_area，方便使用
    
14. 
    
15.       需配合xdrx_api build 11208以上版本使用。
    
16. |;
    
17. 
    
18. (defun c:plarea        (/ kw redraw_le get_area get_layer_area get_point_area)
    
19.   (defun redraw_le ()
    
20.     (foreach e le_drw (redraw e 4))
    
21.     (foreach e le_del (entdel e))
    
22.     (setq le_drw nil
    
23.           le_del nil
    
24.     )
    
25.   )
    
26.   (defun get_area (l / _$area _area ss ss0 ss1 e e1 info pt str len)
    
27.     (setq ss1 (ssadd)
    
28.           _$area 0.0
    
29.     )
    
30.     (princ
    
31.       "\n选择拾取范围 (*polyline,circle,ellipse,spline)<全选>: "
    
32.     )
    
33.     (setq ss (ssget "x" l))
    
34.     (setq ss0 (ssget l)
    
35.           ss  (if ss0
    
36.                 ss0
    
37.                 ss
    
38.               )
    
39.     )
    
40.     (xdrx_setsstodb ss 0)
    
41.     (while (setq e (xdrx_getentdata 0))
    
42.                                         ;(if (xdrx_curve_isclosed e)
    
43.                                         ;        (progn
    
44.       (setq _$area (+ (car (xdrx_getarea e)) _$area))
    
45.                                         ;(command ".text" "j" "mc" pt (* 3 bl) 0 str)
    
46.                                         ;        )
    
47.                                         ;(setq ss1 (ssadd e ss1))
    
48.                                         ;     )
    
49.     )
    
50.     (princ (strcat "\n\t总面积为 " (rtos _$area 2 2) "。"))
    
51.     (xdrx_ucsoff)
    
52.     (xdrx_end)
    
53.     ;|(if        (/= (sslength ss1) 0)
    
54.       (progn
    
55.         (If (And
    
56.               (Zerop (Getvar "cmdactive"))
    
57.               (Ssget "i")
    
58.             )
    
59.           (sssetfirst nil)
    
60.         )
    
61.         (xdrx_setsstodb ss1 0)
    
62.         (while (setq e1 (xdrx_getentdata 0))
    
63.           (redraw e1 3)
    
64.           (setq le_drw (cons e1 le_drw))
    
65.         )
    
66.         (redraw_le)
    
67.         (sssetfirst nil ss1)
    
68.         (setq len (rtos (sslength ss1) 2 0))
    
69.         (prompt
    
70.           (strcat "\n\t" "共 " len " 根非闭合多义线未标注面积。")
    
71.         )
    
72.       )
    
73.     )|;
    
74.   )
    
75.   (defun get_layer_area        (/ e)
    
76.     (setq e (xdrx_entsel "\n拾取实体: "))
    
77.     (princ (strcat "\n你已选择了 " (xdrx_getentdxf 8) " 层"))
    
78.     (get_area (list '(0 . "*polyline,circle,ellipse,spline")
    
79.                     (cons 8 (xdrx_getentdxf 8))
    
80.               )
    
81.     )
    
82.   )
    
83.   (defun get_point_area        (/ p0 e str info tf)
    
84.     (setq p0 (getpoint "\n拾取标注范围内一点: "))
    
85.     (while p0
    
86.       (if (setq e (bpoly p0))
    
87.         (progn
    
88.           (setq info (xdrx_getarea e))
    
89.           (entdel (entlast))
    
90.           (setq str (rtos (/ (car info) 1e6) 2 2))
    
91.           (command ".text" "j" "mc" p0 (* 3 bl) 0 str)
    
92.         )
    
93.         (progn
    
94.           (xdrx_drawing_viewsave)
    
95.           (command ".zoom" ".3x")
    
96.           (setq tf T)
    
97.           (alert "无法找到范围, 重新选择！")
    
98.         )
    
99.       )
    
100.       (setq p0 (getpoint "\n拾取标注范围内一点: "))
     
101.     )
     
102.     (if        tf
     
103.       (xdrx_drawing_viewres)
     
104.     )
     
105.   )
     
106.   (xdrx_begin "tmp_area" "1" '("cmdecho" "0"))
     
107.   (xdrx_ucson)
     
108.   (initget "1 2 3")
     
109.   (setq kw (getkword "\n[1 拾取点/2 按图层/3 选择范围]<3>: "))
     
110.   (cond        ((eq kw "1") (get_point_area))
     
111.         ((eq kw "2") (get_layer_area))
     
112.         (T (get_area '((0 . "*polyline,circle,ellipse,spline"))))
     
113.   )
     
114.   (princ)
     
115. )
     
116. (princ)
     
117. (prompt
     
118.   "\n\t面积标注工具之一Ver 1.0，命令C:plarea。"
     
119. )
     
120. (princ)
     

<br /> ;|<br /> 命令：Plarea<br /> <br /> 功能：计算封闭曲线（*polyline,spline,circle,ellipse)面积并标注<br /> <br /> 说明：用于统计曲线面积，包括三种方式：<br />       1. boundary方式，拾取点，如果生成边界则标面积<br />       2. 统计图层曲线面积 <br />       3. 选择范围后标注所有曲线积    <br /> <br />       程序中标注数字采用了临时图层tmp_area，方便使用<br /> <br />       需配合xdrx_api build 11208以上版本使用。<br /> |;<br /> <br /> (defun c:plarea        (/ kw redraw_le get_area get_layer_area get_point_area)<br />   (defun redraw_le ()<br />     (foreach e le_drw (redraw e 4))<br />     (foreach e le_del (entdel e))<br />     (setq le_drw nil<br />           le_del nil<br />     )<br />   )<br />   (defun get_area (l / _$area _area ss ss0 ss1 e e1 info pt str len)<br />     (setq ss1 (ssadd)<br />           _$area 0.0<br />     )<br />     (princ<br />       "\n选择拾取范围 (*polyline,circle,ellipse,spline)<全选>: "<br />     )<br />     (setq ss (ssget "x" l))<br />     (setq ss0 (ssget l)<br />           ss  (if ss0<br />                 ss0<br />                 ss<br />               )<br />     )<br />     (xdrx_setsstodb ss 0)<br />     (while (setq e (xdrx_getentdata 0))<br />                                         ;(if (xdrx_curve_isclosed e)<br />                                         ;        (progn<br />       (setq _$area (+ (car (xdrx_getarea e)) _$area))<br />                                         ;(command ".text" "j" "mc" pt (* 3 bl) 0 str)<br />                                         ;        )<br />                                         ;(setq ss1 (ssadd e ss1))<br />                                         ;     )<br />     )<br />     (princ (strcat "\n\t总面积为 " (rtos _$area 2 2) "。"))<br />     (xdrx_ucsoff)<br />     (xdrx_end)<br />     ;|(if        (/= (sslength ss1) 0)<br />       (progn<br />         (If (And<br />               (Zerop (Getvar "cmdactive"))<br />               (Ssget "i")<br />             )<br />           (sssetfirst nil)<br />         )<br />         (xdrx_setsstodb ss1 0)<br />         (while (setq e1 (xdrx_getentdata 0))<br />           (redraw e1 3)<br />           (setq le_drw (cons e1 le_drw))<br />         )<br />         (redraw_le)<br />         (sssetfirst nil ss1)<br />         (setq len (rtos (sslength ss1) 2 0))<br />         (prompt<br />           (strcat "\n\t" "共 " len " 根非闭合多义线未标注面积。")<br />         )<br />       )<br />     )|;<br />   )<br />   (defun get_layer_area        (/ e)<br />     (setq e (xdrx_entsel "\n拾取实体: "))<br />     (princ (strcat "\n你已选择了 " (xdrx_getentdxf 8) " 层"))<br />     (get_area (list '(0 . "*polyline,circle,ellipse,spline")<br />                     (cons 8 (xdrx_getentdxf 8))<br />               )<br />     )<br />   )<br />   (defun get_point_area        (/ p0 e str info tf)<br />     (setq p0 (getpoint "\n拾取标注范围内一点: "))<br />     (while p0<br />       (if (setq e (bpoly p0))<br />         (progn<br />           (setq info (xdrx_getarea e))<br />           (entdel (entlast))<br />           (setq str (rtos (/ (car info) 1e6) 2 2))<br />           (command ".text" "j" "mc" p0 (* 3 bl) 0 str)<br />         )<br />         (progn<br />           (xdrx_drawing_viewsave)<br />           (command ".zoom" ".3x")<br />           (setq tf T)<br />           (alert "无法找到范围, 重新选择！")<br />         )<br />       )<br />       (setq p0 (getpoint "\n拾取标注范围内一点: "))<br />     )<br />     (if        tf<br />       (xdrx_drawing_viewres)<br />     )<br />   )<br />   (xdrx_begin "tmp_area" "1" '("cmdecho" "0"))<br />   (xdrx_ucson)<br />   (initget "1 2 3")<br />   (setq kw (getkword "\n[1 拾取点/2 按图层/3 选择范围]<3>: "))<br />   (cond        ((eq kw "1") (get_point_area))<br />         ((eq kw "2") (get_layer_area))<br />         (T (get_area '((0 . "*polyline,circle,ellipse,spline"))))<br />   )<br />   (princ)<br /> )<br /> (princ)<br /> (prompt<br />   "\n\t面积标注工具之一Ver 1.0，命令C:plarea。"<br /> )<br /> (princ)<br />

god

功能真强大，超出我的想象了。

god

用不了啊

我装的是xdbox0.27，xdapi是3010。
Command:
***  == AutoCAD 应用程序开发接口XdRx_API For ACAD R14 Build 30107 ==  ***

***  请访问“晓东的CAD空间 http://xdsoft.126.com”获取最新版本 ***
XDsoft loaded completed.

在r14下出现这种提示。

Command:  PLAREA
[1 拾取点/2 按图层/3 选择范围]<3>: 1
拾取标注范围内一点:
错误: bad argument type

Requires numeric distance or second point.

Requires numeric distance or second point.

Requires numeric distance or second point.
((ST) (IF (AND (/= ST "Function cancelled") (/= ST "quit / exit abort")) (PRINC
(STRCAT "\n错误: " ST "\n"))) (XDRX_END) (XDRX_SYSVAR_POP)
(XDRX_DRAWING_VIEWRES) (XDRX_PBAREND) (SETQ *ERROR* $XDLSP_ERROR))
Height <0.2000>: *Cancel*

Command:  

在2002下出现这种提示。

Regenerating model.

AutoCAD menu utilities loaded.
***  == AutoCAD 应用程序开发接口XdRx_API For ACAD 2000 Build 30107 ==  ***


***  请访问“晓东的CAD空间 http://xdsoft.126.com”获取最新版本 ***
XDsoft loaded completed.
Command:

Command: plarea
[1 拾取点/2 按图层/3 选择范围]<3>: 1
拾取标注范围内一点:
错误: 参数类型错误: numberp: nil

Requires numeric distance or second point.

Requires valid numeric angle or second point.
Unknown command "A".  Press F1 for help.
Unknown command "ON".  Press F1 for help.

Command:

窗口内有一个红色的“undo”。

eachy

忘了，里面有个全局变量 bl 控制字高的，说说你的要求，我可以再改改。还有R14下和2000的 text 命令参数有区别的。

你先在command 下输入 (setq bl 100.0) 后再用程序试试。

god

试了一下，2002下可以用，不过标注的面积不正确，小了很多很多倍。

我觉得选中范围后应暂停一下，以便看清楚选中的范围到底对不对。因为多数情况下，图形的线条比较多，容易出错。

最好也能计算由line组成的封闭图形，

bpoly是xdrx-api吗？

14和2002的text命令不一样吗，我试了试，还是一样的嘛，没看出有什么不一样啊。

其实我觉得用-BOUNDARY命令就能比较完美的找到边界了。再增加一个删除边界和标注，只要几个语句就行了。对吧

god

看看这段代码有什么问题？为什么在acad2002下不能得到面积结果？

(defun c:ww()
        (command "BOUNDARY"  )
        (command "area" "o" (entlast))
        (entdel (entlast))
)

eachy

最初由 god 发布
[B]看看这段代码有什么问题？为什么在acad2002下不能得到面积结果？

(defun c:ww()
        (command "BOUNDARY"  )
        (command "area" "o" (entlast))
        (entdel (entlast))
) [/B]

bpoly 是lisp函数，在手册上没有，我也是经人指点:4 后才知道的。不要用command，用bpoly函数，如果生成线返回实体，否则为nil。

liusz11

最初由 god 发布
[B]看看这段代码有什么问题？为什么在acad2002下不能得到面积结果？

(defun c:ww()
        (command "BOUNDARY"  )
        (command "area" "o" (entlast))
        (entdel (entlast))
) [/B]

这样就可以了：
(defun c:ww()
        (command "BOUNDARY" (getpoint) "")
                     (command "area" "o" (entlast))
        (entdel (entlast))
)
你的问题主要是出在没有正确地结束"boundary"命令。

eachy

最初由 god 发布
[B]为什么求面积代码执行不了呢？

(defun c:ww()
        (bpoly )
        (command "area" "o" (entlast))
) [/B]

应该是

2. 
   
3. (if [color=blue](bpoly (getpoint "\n内部点: "))[/color]
   
4.   (command ".area" "o" (entlast))
   
5. )
   

<br /> (if [color=blue](bpoly (getpoint "\n内部点: "))[/color]<br />   (command ".area" "o" (entlast))<br /> )<br />

另：command 内少用 getxxx 函数，最好在前面单独用 getxxx 获得参数。

god

这句还是不能执行

(command "area" "o" (entlast))

eachy

最初由 god 发布
[B]这句还是不能执行

(command "area" "o" (entlast)) [/B]

完善一下

2. 
   
3. (if (bpoly (getpoint "\n内部点: "))
   
4.   (command ".area" "o" (entlast))
   
5.   (princ "\n无法生成闭合线!")
   
6. )
   

<br /> (if (bpoly (getpoint "\n内部点: "))<br />   (command ".area" "o" (entlast))<br />   (princ "\n无法生成闭合线!")<br /> )<br />

maxbug

最初由 god 发布
[B]这句还是不能执行

(command "area" "o" (entlast)) [/B]

在R14下可行,在ACAD2002下不行.