重复算承台土方体积

树櫴希德

各位，在各位，在算承台土方体积时，需要将承台混凝土四周OFFSET指定距离，如：540毫米，论坛里有一个批量外扩程序，但是无法处理密集承台外扩时侵占相邻承台面积，导致重复算量。哪个高手能解决吗？
时，需要将承台混凝土四周OFFSET指定距离，如：540毫米，论坛里有一个批量外扩程序，但是无法处理密集承台外扩时侵占相邻承台面积，导致重复算量，听说广联达可以解决这个问题。删除批量OFFSET后相交部分并重新构成多段线，再计算面积。哪个高手能解决吗？

p-3-ianlcc

Atsai 发表于 2014-9-5 16:43
我不是高手，效果演示如下图。
利用G版的代码改的，只为了要达到功能。

hi，您好
请教您一下，为什麽我的计算结果没办法读取z值呢？
z值是用text字体打在旁边读取吗？

weilu

有一个很粗暴的方法，直接建立三维模型，然后合并实体。

技术工作室

好东西，顶一个

树櫴希德

这个问题是不是很难啊。发起挑战啊。哪位大神有办法？

树櫴希德

我想应该可以用Gu_xl  大神的LISP改进，大侠们改进下吧

;;批量偏移 By Gu_xl 2013.04.01


(defun c:py (/ CLOCKWISEP OFFSET KD SS N EN kd0)
  (defun CLOCKWISEP (en / lw minp MaxP lst)
    (setq lw (vlax-ename->vla-object en))
    (vla-GetBoundingBox lw 'MinP 'MaxP)
    (setq
      minp (vlax-safearray->list minp)
      MaxP (vlax-safearray->list MaxP)
      lst  (mapcar
             (function
               (lambda (x)
                 (vlax-curve-getParamAtPoint
                   lw
                   (vlax-curve-getClosestPointTo lw x)
                   )
                 )
               )
             (list minp
                   (list (car minp) (cadr MaxP))
                   MaxP
                   (list (car MaxP) (cadr minp))
                   )
             )
      )
    (if (or
          (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
          (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
          (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
          (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
          )
      t
      )
    )
  (initget 7 "W N S  ")
  (setq kd0 (getkword "\n[向外偏移W/向内偏移N/双向偏移S]<W>"))
  (if (= "" kd0)
    (setq kd0 "W")
    )
  (initget 6)
  (setq offset (getreal "\n[输入偏移距离]<0.5>"))
  (if (null offset)
    (setq offset 0.5)
    )
  (initget 7 "Y N  ")
  (setq kd (getkword "\n[删除源对象<Y>/不删除源对象<N>]<N>:"))
  (if (= kd "")
    (setq kd "N")
    )
  (while (setq ss (ssget '((0 . "*polyline,arc,circle"))))
    (repeat (setq n (sslength ss))
      (setq en (ssname ss (setq n (1- n))))
      (cond
        ((or (= "ARC" (cdr (assoc 0 (entget en))))
             (= "CIRCLE" (cdr (assoc 0 (entget en))))
             )
         (cond ((= kd0 "W")
                (vla-offset (vlax-ename->vla-object en) offset)
                )
               ((= kd0 "N")
                (vla-offset (vlax-ename->vla-object en) (- offset))
                )
               (t
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-offset (vlax-ename->vla-object en) (- offset))
                )
               )
         )
        (t
         (cond ((= kd0 "W")
                (if (CLOCKWISEP en)
                  (vla-offset (vlax-ename->vla-object en) (- offset))
                  (vla-offset (vlax-ename->vla-object en) offset)
                  )
                )
               ((= kd0 "N")
                (if (CLOCKWISEP en)
                  (vla-offset (vlax-ename->vla-object en) offset)
                  (vla-offset (vlax-ename->vla-object en) (- offset))
                  )
                )
               (t
                (vla-offset (vlax-ename->vla-object en) offset)
                (vla-offset (vlax-ename->vla-object en) (- offset))
                )
               )

         )
        )
      (if (= kd "Y")
        (entdel en)
        )
      )
    )
  (princ)
  )

伪书虫86

这个用缩放命令写是不是更简单呢

Atsai

1.先求Offset后的矩型与承台矩型间的面域，分成A3：3m、A2：2m及A1：1m。
2. 3m之体积=A3*3m。(A3：面域面积，3m之深度可记于多义线Z值)
    2m之体积=(A2与A3面域差集面积)*2m。
    1m之体积=(A1与A2、A3差集面积)*1m。
    …依此类推
3.将V3+V2+V1就可以得到体积。

树櫴希德

高手有办法吗

Atsai

树櫴希德 发表于 2014-9-3 22:20
高手有办法吗

我不是高手，效果演示如下图。
利用G版的代码改的，只为了要达到功能。

2. 
   
3. (defun c:tt ()
   
4.   (vl-load-com)
   
5.   (setq os (getvar "osmode"))
   
6.   (setvar "osmode" 0)
   
7.   (setvar "cmdecho" 0)
   
8.   (defun CLOCKWISEP (en / lw minp MaxP lst)
   
9.     (setq lw (vlax-ename->vla-object en))
   
10.     (vla-GetBoundingBox lw 'MinP 'MaxP)
    
11.     (setq
    
12.       minp (vlax-safearray->list minp)
    
13.       MaxP (vlax-safearray->list MaxP)
    
14.       lst  (mapcar
    
15.              (function
    
16.                (lambda (x)
    
17.                  (vlax-curve-getParamAtPoint
    
18.                    lw
    
19.                    (vlax-curve-getClosestPointTo lw x)
    
20.                  )
    
21.                )
    
22.              )
    
23.              (list minp
    
24.                    (list (car minp) (cadr MaxP))
    
25.                    MaxP
    
26.                    (list (car MaxP) (cadr minp))
    
27.              )
    
28.            )
    
29.     )
    
30.     (if        (or
    
31.           (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
    
32.           (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
    
33.           (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
    
34.           (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
    
35.         )
    
36.       t
    
37.     )
    
38.   )
    
39. 
    
40. 
    
41.   (setq th (getreal "\n请输入字高<1.0>"))
    
42.   (if (null th)
    
43.     (setq th 1.0)
    
44.   )
    
45. 
    
46.   (initget 6)
    
47.   (setq offset (getreal "\n输入偏移距离<2.0>"))
    
48.   (if (null offset)
    
49.     (setq offset 2.0)
    
50.   )
    
51. 
    
52. 
    
53.   (setq a-lst nil)
    
54.   (setq f-lst nil)
    
55.   (setq ss (ssget '((0 . "*polyline,arc,circle"))))
    
56. 
    
57.   (setq i 0)
    
58.   (setq l (sslength ss))
    
59.   (repeat l
    
60.     ;;repeat 1
    
61.     (setq o-lst nil)
    
62.     (repeat (setq n (sslength ss))
    
63.       ;;repeat 2
    
64.       (setq en (ssname ss (setq n (1- n))))
    
65.       (cond
    
66.         ((or (= "ARC" (cdr (assoc 0 (entget en))))
    
67.              (= "CIRCLE" (cdr (assoc 0 (entget en))))
    
68.          )
    
69.          (vla-offset (vlax-ename->vla-object en) offset)
    
70.         )
    
71.         (t
    
72.          (if (CLOCKWISEP en)
    
73.            (vla-offset (vlax-ename->vla-object en) (- offset))
    
74.            (vla-offset (vlax-ename->vla-object en) offset)
    
75.          )
    
76.         )
    
77.       )
    
78.       ;;end cond
    
79. 
    
80.       (vla-put-Elevation (vlax-ename->vla-object (entlast)) 0.0)
    
81.       (command "region" (entlast) "")
    
82. 
    
83.       (setq o-lst
    
84.              (append
    
85.                o-lst
    
86.                (list
    
87.                  (list (entlast)
    
88.                        (+ (vla-get-Elevation (vlax-ename->vla-object en))
    
89.                           (* n 0.000001)
    
90.                        )
    
91.                  )
    
92.                )
    
93.              )
    
94.       )
    
95.     )
    
96.     ;;end repeat 2
    
97. 
    
98.     (setq
    
99.       o-lst
    
100.        (vl-sort        o-lst
     
101.                 (function (lambda (p1 p2) (> (cadr p1) (cadr p2))))
     
102.        )
     
103.     )
     
104. 
     
105.     (setq ss-c nil
     
106.           ss-c (ssadd)
     
107.     )
     
108. 
     
109.     (foreach y o-lst
     
110.       (if (>= (cadr y) (cadr (nth i o-lst)))
     
111.         (setq ss-c (ssadd (car y) ss-c))
     
112.       )
     
113.     )
     
114. 
     
115.     (command "subtract" (car (nth i o-lst)) "" ss-c "")
     
116. 
     
117.     (setq a-lst
     
118.            (append
     
119.              a-lst
     
120.              (list
     
121.                (list
     
122.                  (vla-get-area (vlax-ename->vla-object (car (nth i o-lst))))
     
123.                  (atof (rtos (cadr (nth i o-lst)) 2 2))
     
124.                )
     
125.              )
     
126.            )
     
127.     )
     
128.     (setq f-lst (append f-lst (list (entget (car (nth i o-lst))))))
     
129. 
     
130.     (setq ss-p (ssget "x" '((0 . "region"))))
     
131.     (command "erase" ss-p "")
     
132. 
     
133.     (setq i (1+ i))
     
134.   )
     
135.   ;;end repeat 1
     
136. 
     
137.   (setq i 0)
     
138.   (foreach x f-lst
     
139.     (entmake x)
     
140.     (setq en (entlast))
     
141.     (setq ptc (vlax-safearray->list
     
142.                 (vlax-variant-value
     
143.                   (vla-get-centroid
     
144.                     (vlax-ename->vla-object en)
     
145.                   )
     
146.                 )
     
147.               )
     
148. 
     
149.     )
     
150.     (command "text" "j" "mc" ptc th "0" (1+ i))
     
151.     (command "circle" ptc th)
     
152.     (setq i (1+ i))
     
153.   )
     
154. 
     
155. 
     
156.   (setq pt (getpoint "\n选择文字插入点:"))
     
157.   (setq vol 0.0)
     
158.   (setq i 0)
     
159.   (foreach x a-lst
     
160.     (setq vol (+ vol (* (car x) (cadr x))))
     
161.     (command "text"
     
162.              "j"
     
163.              "bl"
     
164.              (polar pt (* 1.5 pi) (* i (* 1.5 th)))
     
165.              th
     
166.              "0"
     
167.              (strcat "\nNo"
     
168.                      (rtos (1+ i) 2 0)
     
169.                      ":"
     
170.                      (rtos (car x) 2 2)
     
171.                      "*"
     
172.                      (rtos (cadr x) 2 2)
     
173.                      "="
     
174.                      (rtos (* (car x) (cadr x)) 2 2)
     
175.                      "(m3)"
     
176.              )
     
177.     )
     
178.     (setq i (1+ i))
     
179.   )
     
180. 
     
181.   (command "text"
     
182.            "j"
     
183.            "bl"
     
184.            (polar pt (* 1.5 pi) (* i (* 1.5 th)))
     
185.            th
     
186.            "0"
     
187.            (strcat "\nTotal volume=" (rtos vol 2 2) "(m3)")
     
188.   )
     
189. 
     
190.   (setvar "osmode" os)
     
191.   (princ)
     
192. )
     

<br /> (defun c:tt ()<br />   (vl-load-com)<br />   (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (defun CLOCKWISEP (en / lw minp MaxP lst)<br />     (setq lw (vlax-ename->vla-object en))<br />     (vla-GetBoundingBox lw 'MinP 'MaxP)<br />     (setq<br />       minp (vlax-safearray->list minp)<br />       MaxP (vlax-safearray->list MaxP)<br />       lst  (mapcar<br />              (function<br />                (lambda (x)<br />                  (vlax-curve-getParamAtPoint<br />                    lw<br />                    (vlax-curve-getClosestPointTo lw x)<br />                  )<br />                )<br />              )<br />              (list minp<br />                    (list (car minp) (cadr MaxP))<br />                    MaxP<br />                    (list (car MaxP) (cadr minp))<br />              )<br />            )<br />     )<br />     (if        (or<br />           (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))<br />           (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))<br />           (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))<br />           (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))<br />         )<br />       t<br />     )<br />   )<br /> <br /> <br />   (setq th (getreal "\n请输入字高<1.0>"))<br />   (if (null th)<br />     (setq th 1.0)<br />   )<br /> <br />   (initget 6)<br />   (setq offset (getreal "\n输入偏移距离<2.0>"))<br />   (if (null offset)<br />     (setq offset 2.0)<br />   )<br /> <br /> <br />   (setq a-lst nil)<br />   (setq f-lst nil)<br />   (setq ss (ssget '((0 . "*polyline,arc,circle"))))<br /> <br />   (setq i 0)<br />   (setq l (sslength ss))<br />   (repeat l<br />     ;;repeat 1<br />     (setq o-lst nil)<br />     (repeat (setq n (sslength ss))<br />       ;;repeat 2<br />       (setq en (ssname ss (setq n (1- n))))<br />       (cond<br />         ((or (= "ARC" (cdr (assoc 0 (entget en))))<br />              (= "CIRCLE" (cdr (assoc 0 (entget en))))<br />          )<br />          (vla-offset (vlax-ename->vla-object en) offset)<br />         )<br />         (t<br />          (if (CLOCKWISEP en)<br />            (vla-offset (vlax-ename->vla-object en) (- offset))<br />            (vla-offset (vlax-ename->vla-object en) offset)<br />          )<br />         )<br />       )<br />       ;;end cond<br /> <br />       (vla-put-Elevation (vlax-ename->vla-object (entlast)) 0.0)<br />       (command "region" (entlast) "")<br /> <br />       (setq o-lst<br />              (append<br />                o-lst<br />                (list<br />                  (list (entlast)<br />                        (+ (vla-get-Elevation (vlax-ename->vla-object en))<br />                           (* n 0.000001)<br />                        )<br />                  )<br />                )<br />              )<br />       )<br />     )<br />     ;;end repeat 2<br /> <br />     (setq<br />       o-lst<br />        (vl-sort        o-lst<br />                 (function (lambda (p1 p2) (> (cadr p1) (cadr p2))))<br />        )<br />     )<br /> <br />     (setq ss-c nil<br />           ss-c (ssadd)<br />     )<br /> <br />     (foreach y o-lst<br />       (if (>= (cadr y) (cadr (nth i o-lst)))<br />         (setq ss-c (ssadd (car y) ss-c))<br />       )<br />     )<br /> <br />     (command "subtract" (car (nth i o-lst)) "" ss-c "")<br /> <br />     (setq a-lst<br />            (append<br />              a-lst<br />              (list<br />                (list<br />                  (vla-get-area (vlax-ename->vla-object (car (nth i o-lst))))<br />                  (atof (rtos (cadr (nth i o-lst)) 2 2))<br />                )<br />              )<br />            )<br />     )<br />     (setq f-lst (append f-lst (list (entget (car (nth i o-lst))))))<br /> <br />     (setq ss-p (ssget "x" '((0 . "region"))))<br />     (command "erase" ss-p "")<br /> <br />     (setq i (1+ i))<br />   )<br />   ;;end repeat 1<br /> <br />   (setq i 0)<br />   (foreach x f-lst<br />     (entmake x)<br />     (setq en (entlast))<br />     (setq ptc (vlax-safearray->list<br />                 (vlax-variant-value<br />                   (vla-get-centroid<br />                     (vlax-ename->vla-object en)<br />                   )<br />                 )<br />               )<br /> <br />     )<br />     (command "text" "j" "mc" ptc th "0" (1+ i))<br />     (command "circle" ptc th)<br />     (setq i (1+ i))<br />   )<br /> <br /> <br />   (setq pt (getpoint "\n选择文字插入点:"))<br />   (setq vol 0.0)<br />   (setq i 0)<br />   (foreach x a-lst<br />     (setq vol (+ vol (* (car x) (cadr x))))<br />     (command "text"<br />              "j"<br />              "bl"<br />              (polar pt (* 1.5 pi) (* i (* 1.5 th)))<br />              th<br />              "0"<br />              (strcat "\nNo"<br />                      (rtos (1+ i) 2 0)<br />                      ":"<br />                      (rtos (car x) 2 2)<br />                      "*"<br />                      (rtos (cadr x) 2 2)<br />                      "="<br />                      (rtos (* (car x) (cadr x)) 2 2)<br />                      "(m3)"<br />              )<br />     )<br />     (setq i (1+ i))<br />   )<br /> <br />   (command "text"<br />            "j"<br />            "bl"<br />            (polar pt (* 1.5 pi) (* i (* 1.5 th)))<br />            th<br />            "0"<br />            (strcat "\nTotal volume=" (rtos vol 2 2) "(m3)")<br />   )<br /> <br />   (setvar "osmode" os)<br />   (princ)<br /> )<br />

树櫴希德

上面这个程序就是好啊，解决了承台方量计算这个大问题，以前我一直用手算的，感谢Atsai大侠无私帮助

树櫴希德

大家不要光看不回复啊，为Atsai大侠多赞几下啊

flytoday

放坡后上下底断面不一样~~