[求助]：关于计算面积

saintdog

我经常要计算类似下面图形的面积，可是不知解决思路，无法编程。请各位大虾帮忙——提供解决思路或程序。（以前晓东有一个计算HATCH面积的程序，也能用，但是我的DWG文件中图形很多，招待HATCH命令很费时。）
图例见附件

cy956

?

恐怕人工识别更快。
总得识别外框和孤岛，
你可以编个分别标各个pl的面积，
再加一个加和减的程序；
或者直接在area中a和e。

whscom

我有一个小lsp程序可能对你有用
;(defun getpts (/ pt ptlist)
;(while (setq pt (getpoint " \npoint : "))
;       (setq ptlist (append ptlist(list pt)))))
;************************************
(defun c:ha2 (/ p t sc n)
(if (= 0 (getvar "useri2"))
(setvar "useri2" (setq sc (getint "\nEnter scale of the drawing : ")))
(setq sc (getvar "useri2")))
(setq p (getpoint "\ntext insert point : "))
(command "boundary")
(command p "")
(command "area" "o" "l")
(command "erase" "l" "")
(setq n (/ sc 100000.0))
(setq n (* n n))
(setq t (rtos (* (getvar "area") n) 2 2))
(command "text" p "" "" t)
(princ)
)
在r14下能用

whscom

在r2002下有一些问题，但希望编程思路对你有帮助，或者由坛上的lsp高手重新改一下，再发布，斑竹可否？

XDSoft

去试试“晓东工具箱”新版的计算填充面积的工具。我们院一个人一个星期的工作量，用它几秒就完成了。

eye

2. 
   
3. [FONT=courier new]
   
4. (DEFUN C:ADDS (/ ss en ed as a_txt new_txt ts txt-ts ts1)
   
5.   (SETQ ADDIT NIL
   
6.         SS NIL
   
7.          EN NIL
   
8.           ED NIL
   
9.            AS NIL
   
10.             A_TXT NIL
    
11.              NEW_TXT NIL)
    
12.   (SETQ A_TXT 0)
    
13.   (PROMPT "\nSELECT TEXT TO ADD TOGETHER(请选取想累加的数字): ")
    
14.   (SETQ SS (SSGET))
    
15.   (WHILE (> (SSLENGTH SS) 0)
    
16.     (SETQ EN (SSNAME SS 0))
    
17.     (SETQ ED (ENTGET EN))
    
18.     (SETQ AS (CDR (ASSOC '0 ED)))
    
19.     (IF (= AS "TEXT")
    
20.       (_TXT)
    
21.     )
    
22.     (SSDEL EN SS)
    
23.   )
    
24.   (SETQ ADDIT NIL
    
25.         SS NIL
    
26.         EN NIL
    
27.         ED NIL
    
28.         AS NIL
    
29.         A_TXT NIL
    
30.         NEW_TXT NIL)
    
31.   (PROMPT (STRCAT "\nTOTAL NUMBER IS (他们的和是): " NEW_TEXT))
    
32.        (setq ts (getvar "TEXTSIZE"))
    
33.                 (setq txt-ts (strcat "\n 文本尺寸为" (RTOS TS 2 1)))
    
34.                         (PROMPT TXT-TS)
    
35.                                 (SETQ TS1 (GETREAL "\n文本尺寸为<回车默认值>"))
    
36.                                         (if (= ts1 nil) (setq ts ts) (setq ts ts1))
    
37.                                                 (setvar "textsize" ts)
    
38.         (setq ps (getpoint "   Where you want to dim :"))
    
39.                         (command "text" ps "" "0" NEW_TEXT)       
    
40. )
    
41. (DEFUN _TXT ()
    
42.   (SETQ A_TXT (+ (DISTOF (CDR (ASSOC '1 ED)) 3) A_TXT))
    
43.   (SETQ NEW_TEXT (RTOS A_TXT 2 2))
    
44.   (SSDEL EN SS)
    
45. )[/FONT]

<br /> [FONT=courier new]<br /> (DEFUN C:ADDS (/ ss en ed as a_txt new_txt ts txt-ts ts1) <br />   (SETQ ADDIT NIL <br />         SS NIL <br />          EN NIL <br />           ED NIL <br />            AS NIL <br />             A_TXT NIL <br />              NEW_TXT NIL)<br />   (SETQ A_TXT 0)<br />   (PROMPT "\nSELECT TEXT TO ADD TOGETHER(请选取想累加的数字): ") <br />   (SETQ SS (SSGET))<br />   (WHILE (> (SSLENGTH SS) 0) <br />     (SETQ EN (SSNAME SS 0))<br />     (SETQ ED (ENTGET EN))<br />     (SETQ AS (CDR (ASSOC '0 ED)))<br />     (IF (= AS "TEXT") <br />       (_TXT)<br />     ) <br />     (SSDEL EN SS)<br />   ) <br />   (SETQ ADDIT NIL <br />         SS NIL <br />         EN NIL <br />         ED NIL <br />         AS NIL <br />         A_TXT NIL <br />         NEW_TXT NIL)<br />   (PROMPT (STRCAT "\nTOTAL NUMBER IS (他们的和是): " NEW_TEXT))<br />        (setq ts (getvar "TEXTSIZE"))<br />                 (setq txt-ts (strcat "\n 文本尺寸为" (RTOS TS 2 1)))<br />                         (PROMPT TXT-TS)<br />                                 (SETQ TS1 (GETREAL "\n文本尺寸为<回车默认值>"))<br />                                         (if (= ts1 nil) (setq ts ts) (setq ts ts1))<br />                                                 (setvar "textsize" ts)<br />         (setq ps (getpoint "   Where you want to dim :"))<br />                         (command "text" ps "" "0" NEW_TEXT)        <br /> ) <br /> (DEFUN _TXT () <br />   (SETQ A_TXT (+ (DISTOF (CDR (ASSOC '1 ED)) 3) A_TXT))<br />   (SETQ NEW_TEXT (RTOS A_TXT 2 2))<br />   (SSDEL EN SS)<br /> )[/FONT]

yc314

不错！