[求助]：求体积（土方图中方格网计算）

ZHGWF

已知底面面积，任意四个顶点高度，求体积（土方图中方格网计算）

eachy

看资料集，你要先知道计算公式

xyp1964

2. [FONT=courier new](load "xyp_lib.vlx")                        ;版本 V.20060430
   
3. ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
   
4. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
5. ★1·在acad.lsp中增加(load"xyp_lib.vlx")
   
6. ■2·在每个程序内增加(load"xyp_lib.vlx")
   
7. ■3·在command下，输入(load"xyp_lib.vlx")
   
8. ■4·在菜单.mnl中增加(load"xyp_lib.vlx")
   
9. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
   
10. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
11. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
12. [url]http://free.ys168.com/?xyp1964[/url]
    
13. |;
    
14. 
    
15. ;;; 四边形土方量：
    
16. ;;; 拾取四边形的四个角点坐标计算四边形面积s
    
17. ;;; 拾取施工高度h1、h2、h3、h4
    
18. ;;; v=S*(h1+h2+h3+h4)/4
    
19. (defun c:SBXTFL        (/ pt0 en s a1 a2 a3 a4 b1 b2 b3 b4 V v1 pt)
    
20.   (CMDLASC0)
    
21.   (setvar "osmode" 0)
    
22.   (XYP-MkLaCo "temp" 2)
    
23.   (setq pt0 (getpoint "\n点取四边形内一点: "))
    
24.   (command "-boundary" "a" "o" "r" "" pt0 "")
    
25.   (setq en (entlast))
    
26.   (if (/= en nil)
    
27.     (progn
    
28.       (setq s  (vla-get-Area (vlax-ename->vla-object en))
    
29.             a1 (car (USEL 0 "TEXT" "\n屏幕拾取四边形施工高度1: "))
    
30.             a2 (car (USEL 0 "TEXT" "\n屏幕拾取四边形施工高度2: "))
    
31.             a3 (car (USEL 0 "TEXT" "\n屏幕拾取四边形施工高度3: "))
    
32.             a4 (car (USEL 0 "TEXT" "\n屏幕拾取四边形施工高度4: "))
    
33.             b1 (atof (xyp-get-dxf 1 a1))
    
34.             b2 (atof (xyp-get-dxf 1 a2))
    
35.             b3 (atof (xyp-get-dxf 1 a3))
    
36.             b4 (atof (xyp-get-dxf 1 a4))
    
37.             V  (* s (/ (+ b1 b2 b3 b4) 4))
    
38.             V1 (rtos V 2 2)
    
39.             pt (vlax-safearray->list
    
40.                  (vlax-variant-value
    
41.                    (vla-get-centroid (vlax-ename->vla-object en))
    
42.                  )
    
43.                )
    
44.       )
    
45.       (if (> v 0)
    
46.         (setq v1 (strcat "+" v1))
    
47.       )
    
48.       (mkla "土方量2" 4)
    
49.       (xyp-Text 5 pt v1)
    
50.       ;;(entdel en)
    
51.     )
    
52.     (princ "\n此区域不封闭! ")
    
53.   )
    
54.   (CMDLA1)
    
55. )
    
56. (PXYP "SBXTFL  (四边形土方量)")[/FONT]

[FONT=courier new](load "xyp_lib.vlx")                        ;版本 V.20060430<br /> ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)<br /> 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：<br /> ★1·在acad.lsp中增加(load"xyp_lib.vlx")<br /> ■2·在每个程序内增加(load"xyp_lib.vlx")<br /> ■3·在command下，输入(load"xyp_lib.vlx")<br /> ■4·在菜单.mnl中增加(load"xyp_lib.vlx")<br /> ■5·将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> [url]http://free.ys168.com/?xyp1964[/url]<br /> |;<br /> <br /> ;;; 四边形土方量：<br /> ;;; 拾取四边形的四个角点坐标计算四边形面积s<br /> ;;; 拾取施工高度h1、h2、h3、h4<br /> ;;; v=S*(h1+h2+h3+h4)/4<br /> (defun c:SBXTFL        (/ pt0 en s a1 a2 a3 a4 b1 b2 b3 b4 V v1 pt)<br />   (CMDLASC0)<br />   (setvar "osmode" 0)<br />   (XYP-MkLaCo "temp" 2)<br />   (setq pt0 (getpoint "\n点取四边形内一点: "))<br />   (command "-boundary" "a" "o" "r" "" pt0 "")<br />   (setq en (entlast))<br />   (if (/= en nil)<br />     (progn<br />       (setq s  (vla-get-Area (vlax-ename->vla-object en))<br />             a1 (car (USEL 0 "TEXT" "\n屏幕拾取四边形施工高度1: "))<br />             a2 (car (USEL 0 "TEXT" "\n屏幕拾取四边形施工高度2: "))<br />             a3 (car (USEL 0 "TEXT" "\n屏幕拾取四边形施工高度3: "))<br />             a4 (car (USEL 0 "TEXT" "\n屏幕拾取四边形施工高度4: "))<br />             b1 (atof (xyp-get-dxf 1 a1))<br />             b2 (atof (xyp-get-dxf 1 a2))<br />             b3 (atof (xyp-get-dxf 1 a3))<br />             b4 (atof (xyp-get-dxf 1 a4))<br />             V  (* s (/ (+ b1 b2 b3 b4) 4))<br />             V1 (rtos V 2 2)<br />             pt (vlax-safearray->list<br />                  (vlax-variant-value<br />                    (vla-get-centroid (vlax-ename->vla-object en))<br />                  )<br />                )<br />       )<br />       (if (> v 0)<br />         (setq v1 (strcat "+" v1))<br />       )<br />       (mkla "土方量2" 4)<br />       (xyp-Text 5 pt v1)<br />       ;;(entdel en)<br />     )<br />     (princ "\n此区域不封闭! ")<br />   )<br />   (CMDLA1)<br /> )<br /> (PXYP "SBXTFL  (四边形土方量)")[/FONT]

ZHGWF

谢谢斑竹。对单个方格来说，很方便。