[原创]：建筑面积 公摊面积 处理命令

vang8866

sss  命令 得出闭合曲线面积
add  命令 把闭合曲线面积相加 （算总面积）
gta  命令 算公摊
提供源代码

zh_6531394

上当了,
sss 命令 得出闭合曲线面积
gta 命令 算公摊
用不起来

vang8866

不会啊。。。请先建一个 名为  SS  的层 怎会那么不厚道 骗你呢

zh_6531394

命令: sss
选择对象: 指定对角点: 找到 2 个
已滤除 2 个。
选择对象:
Error: 参数类型错误: lselsetp nil.

2sunny2

我还是没清楚啊？什么意思啊

vang8866

to  4楼
请先建 一名为SS 的土层 谢谢

zh_6531394

建过名为SS 的图层,还是错

wxl1981807

好东西，免币更好了

xyp1964

确实有问题，公布出来，大家评评。
1.为什么闭合曲线一定要在ss层上？
2.(SETQ SSS5 (ASSOC'1(ENTGET SSS4)))得到什么结果？

2. [FONT=courier new];;*****************************************************************
   
3. ;;**                      闭合曲线面积                           **
   
4. ;;*****************************************************************
   
5. (defun c:SSS (/ LC SSS1 SSS2 SSS3 SSS4 SSS5 SSS6 SSS7 SSS8)
   
6.   (setvar "cmdecho" 0)
   
7.   (command "osnap" "none")
   
8.   (setq Lc (getvar "cLayer"))
   
9.   (command "layer" "s" "SS" "")
   
10.   (setq SSS1 (ssget '((8 . "SS"))))
    
11.   (setq SSS2 0)
    
12.   (setq SSS3 (ssLength SSS1))
    
13.   (SETQ SSS7 0)
    
14.   (repeat SSS3                       
    
15.     (setq SSS4 (ssname SSS1 SSS2))
    
16.     (SETQ SSS5 (ASSOC'1(ENTGET SSS4)))
    
17.     (SETQ SSS6 (ATOF(SUBSTR (CDR SSS5) 3)))
    
18.     (setq SSS2 (1+ SSS2))
    
19.     (SETQ SSS7 (+ SSS6 SSS7))
    
20.   )
    
21.   (PROMPT (STRCAT "\nTOTAL AREA IS : " (RTOS SSS7 2 2)))
    
22.   (setq SSS8 (getpoint "\nInsertion point for total value: "))
    
23.   (command "._text" "middle" SSS8)
    
24.   (if (= 0.0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
    
25.            (command "" "" (STRCAT "S=" (RTOS SSS7 2 2) "M^2"))
    
26.            (command "" (STRCAT "S=" (RTOS SSS7 2 2) "M^2"))
    
27.         )
    
28.   (command "Layer" "S" Lc "")
    
29.   (PRINC)
    
30. )
    
31. 
    
32. ;;*****************************************************************
    
33. ;;**                      曲线面积相加                           **
    
34. ;;*****************************************************************
    
35. ; Total area of closed polylines (c) Chris Hardwicke 1996
    
36. 
    
37. (DEFUN C:ADD ()
    
38.   (PROMPT "\n(c) Chris Hardwicke 1996")
    
39.   (PROMPT "\nSELECT AREAS TO ADD TOGETHER: ")
    
40.   (SETQ P_AREA 0)
    
41.   (SETQ SS (SSGET))
    
42.   ;(SETQ AREA_FILE (OPEN "AREAS.FIL" "a"))
    
43.   (WHILE (> (SSLENGTH SS) 0)
    
44.     (SETQ EN (SSNAME SS 0))
    
45.     (SETQ ED (ENTGET EN))
    
46.     (SETQ AS (CDR (ASSOC '0 ED)))
    
47.     (IF (AND (OR (= AS "POLYLINE") (= AS "LWPOLYLINE")) (= (CDR (ASSOC '70 ED)) 1))
    
48.       (PROGN
    
49.         (COMMAND "AREA" "O" EN)
    
50.         (SETQ P_AREA (/ (+ P_AREA (GETVAR "AREA")) 1000000))
    
51.         ;(WRITE-LINE (RTOS (GETVAR "AREA") 2 2) AREA_FILE)
    
52.         (SSDEL EN SS)
    
53.       )
    
54.       (SSDEL EN SS)
    
55.     )
    
56.   )
    
57.   ;(CLOSE AREA_FILE)
    
58.   (setq Lc (getvar "cLayer"))
    
59.   (command "layer" "N" "SS" "")
    
60.   (command "layer" "S" "SS" "")
    
61.   (PROMPT (STRCAT "\nTOTAL AREA IS : " (RTOS P_AREA 2 2)))
    
62.   (setq txtPt (getpoint "\nInsertion point for total value: "))
    
63.   (command "._text" "middle" txtpt)
    
64.   (if (= 0.0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
    
65.              (command "" "" (STRCAT "S=" (RTOS P_AREA 2 2) "M^2"))
    
66.              (command "" (STRCAT "S=" (RTOS P_AREA 2 2) "M^2"))
    
67.             )
    
68.   (command "Layer" "S" Lc "")
    
69. 
    
70. )
    
71. ;;*****************************************************************
    
72. ;;**                      算公摊                                 **
    
73. ;;*****************************************************************
    
74. (defun c:gta (/ LC gta1 gta2 gta3 gta4 gta5 gta6 gta7 gta8)
    
75.   (setvar "cmdecho" 0)
    
76.   (command "osnap" "none")
    
77.   (setq Lc (getvar "cLayer"))
    
78.   (command "layer" "s" "SS" "")
    
79.   (setq gta01 (nentsel "取分摊面积:"))
    
80.   (setq gta02 (nentsel "取总面积:"))
    
81.   (setq gta03 (assoc 1 (entget (car gta01)))
    
82.         gta04 (ATOF(SUBSTR (CDR gta03) 3)))
    
83.   (setq gta05 (assoc 1 (entget (car gta02)))
    
84.         gta06 (ATOF(SUBSTR (CDR gta05) 3)))
    
85.   (setq gta07 (- 1(/ gta04 gta06)))
    
86.   (setq gta1 (ssget '((8 . "SS") )))
    
87.   (setq gta2 0
    
88.         gta3 (ssLength gta1))                         
    
89.   (setq gta4 (ssname gta1 gta2))
    
90.   (SETQ gta5 (ASSOC'1(ENTGET gta4)))
    
91.   (SETQ gta6 (ATOF(SUBSTR (CDR gta5) 3)))
    
92.   (SETQ gta6 (/ gta6 gta07))
    
93.   (PROMPT (STRCAT "\nTOTAL AREA IS : " (RTOS gta6 2 2)))
    
94.   (setq gta8 (getpoint "\nInsertion point for total value: "))
    
95.   (command "._text" "middle" gta8)
    
96.   (if (= 0.0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
    
97.            (command "" "" (STRCAT "S=" (RTOS gta6 2 2) "M^2"))
    
98.            (command "" (STRCAT "S=" (RTOS gta6 2 2) "M^2"))
    
99.         )
    
100.   (command "Layer" "S" Lc "")
     
101.   (PRINC)
     
102. )[/FONT]

[FONT=courier new];;*****************************************************************<br /> ;;**                      闭合曲线面积                           **<br /> ;;*****************************************************************<br /> (defun c:SSS (/ LC SSS1 SSS2 SSS3 SSS4 SSS5 SSS6 SSS7 SSS8)<br />   (setvar "cmdecho" 0)<br />   (command "osnap" "none")<br />   (setq Lc (getvar "cLayer"))<br />   (command "layer" "s" "SS" "")<br />   (setq SSS1 (ssget '((8 . "SS"))))<br />   (setq SSS2 0)<br />   (setq SSS3 (ssLength SSS1))<br />   (SETQ SSS7 0)<br />   (repeat SSS3                        <br />     (setq SSS4 (ssname SSS1 SSS2))<br />     (SETQ SSS5 (ASSOC'1(ENTGET SSS4)))<br />     (SETQ SSS6 (ATOF(SUBSTR (CDR SSS5) 3)))<br />     (setq SSS2 (1+ SSS2))<br />     (SETQ SSS7 (+ SSS6 SSS7))<br />   )<br />   (PROMPT (STRCAT "\nTOTAL AREA IS : " (RTOS SSS7 2 2)))<br />   (setq SSS8 (getpoint "\nInsertion point for total value: "))<br />   (command "._text" "middle" SSS8)<br />   (if (= 0.0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))<br />            (command "" "" (STRCAT "S=" (RTOS SSS7 2 2) "M^2"))<br />            (command "" (STRCAT "S=" (RTOS SSS7 2 2) "M^2"))<br />         )<br />   (command "Layer" "S" Lc "")<br />   (PRINC)<br /> )<br /> <br /> ;;*****************************************************************<br /> ;;**                      曲线面积相加                           **<br /> ;;*****************************************************************<br /> ; Total area of closed polylines (c) Chris Hardwicke 1996<br /> <br /> (DEFUN C:ADD ()<br />   (PROMPT "\n(c) Chris Hardwicke 1996")<br />   (PROMPT "\nSELECT AREAS TO ADD TOGETHER: ")<br />   (SETQ P_AREA 0)<br />   (SETQ SS (SSGET))<br />   ;(SETQ AREA_FILE (OPEN "AREAS.FIL" "a"))<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 (AND (OR (= AS "POLYLINE") (= AS "LWPOLYLINE")) (= (CDR (ASSOC '70 ED)) 1))<br />       (PROGN<br />         (COMMAND "AREA" "O" EN)<br />         (SETQ P_AREA (/ (+ P_AREA (GETVAR "AREA")) 1000000))<br />         ;(WRITE-LINE (RTOS (GETVAR "AREA") 2 2) AREA_FILE)<br />         (SSDEL EN SS)<br />       )<br />       (SSDEL EN SS)<br />     )<br />   )<br />   ;(CLOSE AREA_FILE)<br />   (setq Lc (getvar "cLayer"))<br />   (command "layer" "N" "SS" "")<br />   (command "layer" "S" "SS" "")<br />   (PROMPT (STRCAT "\nTOTAL AREA IS : " (RTOS P_AREA 2 2)))<br />   (setq txtPt (getpoint "\nInsertion point for total value: "))<br />   (command "._text" "middle" txtpt)<br />   (if (= 0.0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))<br />              (command "" "" (STRCAT "S=" (RTOS P_AREA 2 2) "M^2"))<br />              (command "" (STRCAT "S=" (RTOS P_AREA 2 2) "M^2"))<br />             )<br />   (command "Layer" "S" Lc "")<br /> <br /> )<br /> ;;*****************************************************************<br /> ;;**                      算公摊                                 **<br /> ;;*****************************************************************<br /> (defun c:gta (/ LC gta1 gta2 gta3 gta4 gta5 gta6 gta7 gta8)<br />   (setvar "cmdecho" 0)<br />   (command "osnap" "none")<br />   (setq Lc (getvar "cLayer"))<br />   (command "layer" "s" "SS" "")<br />   (setq gta01 (nentsel "取分摊面积:"))<br />   (setq gta02 (nentsel "取总面积:"))<br />   (setq gta03 (assoc 1 (entget (car gta01)))<br />         gta04 (ATOF(SUBSTR (CDR gta03) 3)))<br />   (setq gta05 (assoc 1 (entget (car gta02)))<br />         gta06 (ATOF(SUBSTR (CDR gta05) 3)))<br />   (setq gta07 (- 1(/ gta04 gta06)))<br />   (setq gta1 (ssget '((8 . "SS") )))<br />   (setq gta2 0<br />         gta3 (ssLength gta1))                          <br />   (setq gta4 (ssname gta1 gta2))<br />   (SETQ gta5 (ASSOC'1(ENTGET gta4)))<br />   (SETQ gta6 (ATOF(SUBSTR (CDR gta5) 3)))<br />   (SETQ gta6 (/ gta6 gta07))<br />   (PROMPT (STRCAT "\nTOTAL AREA IS : " (RTOS gta6 2 2)))<br />   (setq gta8 (getpoint "\nInsertion point for total value: "))<br />   (command "._text" "middle" gta8)<br />   (if (= 0.0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))<br />            (command "" "" (STRCAT "S=" (RTOS gta6 2 2) "M^2"))<br />            (command "" (STRCAT "S=" (RTOS gta6 2 2) "M^2"))<br />         )<br />   (command "Layer" "S" Lc "")<br />   (PRINC)<br /> )[/FONT]