测量面积的LISP代码

Lisphk

1. ;get area
   
2. (defun C:GETAREA  ( /  ss e ent lyname ls llist)
   
3.   (setq ss (ssget))
   
4.   (while ss
   
5.     (setq
   
6.       e (ssname ss 0)
   
7.       ent (entget e)
   
8.       ss (if (> (sslength ss) 1)
   
9.              (ssdel e ss)
   
10.           nil
    
11.          )
    
12.     )
    
13.     (cond ((or (=  (cdr (assoc 0 ent))  "LWPOLYLINE") (=  (cdr (assoc 0 ent))  "POLYLINE"))
    
14.       (command "AREA" "e" e)
    
15.       (setq
    
16.         lyname (cdr (assoc 8 ent))
    
17.         ls (assoc lyname llist)
    
18.         ls1 (cons lyname (+ (if ls (cdr ls) 0) (getvar "AREA")))
    
19.         llist (if ls (subst ls1 ls llist) (cons ls1 llist))
    
20.       )
    
21.     ))
    
22.   )
    
23.   llist
    
24. )
    
25. 
    

;get area<br /> (defun C:GETAREA  ( /  ss e ent lyname ls llist)<br />   (setq ss (ssget))<br />   (while ss<br />     (setq <br />       e (ssname ss 0) <br />       ent (entget e)<br />       ss (if (> (sslength ss) 1)<br />              (ssdel e ss)<br />           nil<br />          )<br />     )<br />     (cond ((or (=  (cdr (assoc 0 ent))  "LWPOLYLINE") (=  (cdr (assoc 0 ent))  "POLYLINE"))<br />       (command "AREA" "e" e)<br />       (setq<br />         lyname (cdr (assoc 8 ent))<br />         ls (assoc lyname llist)<br />         ls1 (cons lyname (+ (if ls (cdr ls) 0) (getvar "AREA"))) <br />         llist (if ls (subst ls1 ls llist) (cons ls1 llist))<br />       )<br />     ))<br />   )<br />   llist<br /> )<br /> <br />

xvjiex

感谢楼主分享测量面积的LISP代码

willclark

学习中~~~~~~~~~~~~~