重复算承台土方体积
各位，在各位，在算承台土方体积时，需要将承台混凝土四周OFFSET指定距离，如：540毫米，论坛里有一个批量外扩程序，但是无法处理密集承台外扩时侵占相邻承台面积，导致重复算量。哪个高手能解决吗？时，需要将承台混凝土四周OFFSET指定距离，如：540毫米，论坛里有一个批量外扩程序，但是无法处理密集承台外扩时侵占相邻承台面积，导致重复算量，听说广联达可以解决这个问题。删除批量OFFSET后相交部分并重新构成多段线，再计算面积。哪个高手能解决吗？
Atsai 发表于 2014-9-5 16:43
我不是高手，效果演示如下图。
利用G版的代码改的，只为了要达到功能。
hi，您好
请教您一下，为什麽我的计算结果没办法读取z值呢？
z值是用text字体打在旁边读取吗？ 有一个很粗暴的方法，直接建立三维模型，然后合并实体。 好东西，顶一个 本帖最后由 树櫴希德 于 2014-8-22 08:48 编辑
这个问题是不是很难啊。发起挑战啊。哪位大神有办法？ 本帖最后由 树櫴希德 于 2014-8-22 08:49 编辑
我想应该可以用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)
)
这个用缩放命令写是不是更简单呢
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-5 16:45 编辑
树櫴希德 发表于 2014-9-3 22:20 static/image/common/back.gif
高手有办法吗
我不是高手，效果演示如下图。
利用G版的代码改的，只为了要达到功能。
(defun c:tt ()
(vl-load-com)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(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
)
)
(setq th (getreal "\n请输入字高<1.0>"))
(if (null th)
(setq th 1.0)
)
(initget 6)
(setq offset (getreal "\n输入偏移距离<2.0>"))
(if (null offset)
(setq offset 2.0)
)
(setq a-lst nil)
(setq f-lst nil)
(setq ss (ssget '((0 . "*polyline,arc,circle"))))
(setq i 0)
(setq l (sslength ss))
(repeat l
;;repeat 1
(setq o-lst nil)
(repeat (setq n (sslength ss))
;;repeat 2
(setq en (ssname ss (setq n (1- n))))
(cond
((or (= "ARC" (cdr (assoc 0 (entget en))))
(= "CIRCLE" (cdr (assoc 0 (entget en))))
)
(vla-offset (vlax-ename->vla-object en) offset)
)
(t
(if (CLOCKWISEP en)
(vla-offset (vlax-ename->vla-object en) (- offset))
(vla-offset (vlax-ename->vla-object en) offset)
)
)
)
;;end cond
(vla-put-Elevation (vlax-ename->vla-object (entlast)) 0.0)
(command "region" (entlast) "")
(setq o-lst
(append
o-lst
(list
(list (entlast)
(+ (vla-get-Elevation (vlax-ename->vla-object en))
(* n 0.000001)
)
)
)
)
)
)
;;end repeat 2
(setq
o-lst
(vl-sort o-lst
(function (lambda (p1 p2) (> (cadr p1) (cadr p2))))
)
)
(setq ss-c nil
ss-c (ssadd)
)
(foreach y o-lst
(if (>= (cadr y) (cadr (nth i o-lst)))
(setq ss-c (ssadd (car y) ss-c))
)
)
(command "subtract" (car (nth i o-lst)) "" ss-c "")
(setq a-lst
(append
a-lst
(list
(list
(vla-get-area (vlax-ename->vla-object (car (nth i o-lst))))
(atof (rtos (cadr (nth i o-lst)) 2 2))
)
)
)
)
(setq f-lst (append f-lst (list (entget (car (nth i o-lst))))))
(setq ss-p (ssget "x" '((0 . "region"))))
(command "erase" ss-p "")
(setq i (1+ i))
)
;;end repeat 1
(setq i 0)
(foreach x f-lst
(entmake x)
(setq en (entlast))
(setq ptc (vlax-safearray->list
(vlax-variant-value
(vla-get-centroid
(vlax-ename->vla-object en)
)
)
)
)
(command "text" "j" "mc" ptc th "0" (1+ i))
(command "circle" ptc th)
(setq i (1+ i))
)
(setq pt (getpoint "\n选择文字插入点:"))
(setq vol 0.0)
(setq i 0)
(foreach x a-lst
(setq vol (+ vol (* (car x) (cadr x))))
(command "text"
"j"
"bl"
(polar pt (* 1.5 pi) (* i (* 1.5 th)))
th
"0"
(strcat "\nNo"
(rtos (1+ i) 2 0)
":"
(rtos (car x) 2 2)
"*"
(rtos (cadr x) 2 2)
"="
(rtos (* (car x) (cadr x)) 2 2)
"(m3)"
)
)
(setq i (1+ i))
)
(command "text"
"j"
"bl"
(polar pt (* 1.5 pi) (* i (* 1.5 th)))
th
"0"
(strcat "\nTotal volume=" (rtos vol 2 2) "(m3)")
)
(setvar "osmode" os)
(princ)
)
上面这个程序就是好啊，解决了承台方量计算这个大问题，以前我一直用手算的，感谢Atsai大侠无私帮助 大家不要光看不回复啊，为Atsai大侠多赞几下啊 放坡后上下底断面不一样~~
页:
[1]
2