面积统计求和

szx025

2. (DEFUN C:da (/ bs aa per ptu ptd txth)
   
3.     (setvar "cmdecho" 0)
   
4.     (princ
   
5.   "\n说明:在使用本程序前请先生成房间的多义线!本程序默认原绘图单位为MM!"
   
6.     )
   
7.     ;;  (princ "\n点取房间多义线:")
   
8.     ;;  (setq bs (ssget))
   
9.     (if  (setq bs (entsel "\n点取房间多义线:"))
   
10.   (progn
    
11.       (command "_area" "o" bs)
    
12.       (setq aa (getvar "area"))
    
13.       (setq aa (/ aa 1000000.0))
    
14.       　　　
    
15.       (setq aa (rtos aa 2 2))
    
16.       ;;(setq aa (strcat "A=" aa))
    
17.       ;;(setq aa (strcat aa "M2"))
    
18.       (setq aa (strcat "A=" aa "M2"))
    
19. 
    
20.       (setq per (getvar "perimeter"))
    
21.       (setq per (/ per 1000.0))
    
22.       　　　
    
23.       (setq per (rtos per 2 2))
    
24.       ;;(setq per (strcat "P=" per))
    
25.       ;;(setq per (strcat per "M"))
    
26.       (setq per (strcat "P=" per "m"))
    
27. 
    
28.       (setq txth (* (getvar "hpscale") 500))
    
29.       (if  (setq pt (getpoint "\n点取标注点:"))
    
30.     (progn
    
31.         ;;(setq ptu (list (car pt) (+ (cadr pt) (* txth 0.6)) 0.0))
    
32.         ;;(setq ptd (list (car pt) (- (cadr pt) (* txth 0.6)) 0.0))
    
33.         (setq ptu (polar pt (* 0.5 pi) (* txth 0.6))
    
34.         ptd (polar pt (* 1.5 pi) (* txth 0.6))
    
35.         )
    
36.         (command "text" "j" "mc" ptu txth "0" aa)
    
37.         (command "text" "j" "mc" ptd txth "0" per)
    
38.         (command "erase" bs "")
    
39.     )
    
40.       )
    
41.   )
    
42.     )
    
43.     (setvar "cmdecho" 1)
    
44.     (princ)
    
45. )

(DEFUN C:da (/ bs aa per ptu ptd txth)<br />     (setvar "cmdecho" 0)<br />     (princ<br />   "\n说明:在使用本程序前请先生成房间的多义线!本程序默认原绘图单位为MM!"<br />     )<br />     ;;  (princ "\n点取房间多义线:")<br />     ;;  (setq bs (ssget))<br />     (if  (setq bs (entsel "\n点取房间多义线:"))<br />   (progn<br />       (command "_area" "o" bs)<br />       (setq aa (getvar "area"))<br />       (setq aa (/ aa 1000000.0))<br />       　　　<br />       (setq aa (rtos aa 2 2))<br />       ;;(setq aa (strcat "A=" aa))<br />       ;;(setq aa (strcat aa "M2"))<br />       (setq aa (strcat "A=" aa "M2"))<br /> <br />       (setq per (getvar "perimeter"))<br />       (setq per (/ per 1000.0))<br />       　　　<br />       (setq per (rtos per 2 2))<br />       ;;(setq per (strcat "P=" per))<br />       ;;(setq per (strcat per "M"))<br />       (setq per (strcat "P=" per "m"))<br /> <br />       (setq txth (* (getvar "hpscale") 500))<br />       (if  (setq pt (getpoint "\n点取标注点:"))<br />     (progn<br />         ;;(setq ptu (list (car pt) (+ (cadr pt) (* txth 0.6)) 0.0))<br />         ;;(setq ptd (list (car pt) (- (cadr pt) (* txth 0.6)) 0.0))<br />         (setq ptu (polar pt (* 0.5 pi) (* txth 0.6))<br />         ptd (polar pt (* 1.5 pi) (* txth 0.6))<br />         )<br />         (command "text" "j" "mc" ptu txth "0" aa)<br />         (command "text" "j" "mc" ptd txth "0" per)<br />         (command "erase" bs "")<br />     )<br />       )<br />   )<br />     )<br />     (setvar "cmdecho" 1)<br />     (princ)<br /> )

这是一个选择闭合多义线标注面积和周长的程序，请高手再完善一下，增加一个统计求和的功能，就是把标注的多个面积和周长计算一个总和标注在图纸中