在ＣＡＳＳ中 图面拾取高程点 求累计值 和平均值（原）

skg123

本小程序 用于 计算 图面局部高程点平均，
1、选中后会 亮显高程，可以分辨是否已经选择过，避免重复选择，退出后 命令行输入 regen  之后亮显消失；
2、程序的漏洞是 空选 就出现错误，将退出；
(defun:pjz()
(setvar "cmdecho" 0) ;指令执行过程不响应
(setq i 0)
(setq zh 0)
(while
(setq en (entsel "\n选择高程点:"))
(setvar "cmdecho" 0)
(redraw (car en) 3);亮显高程点
(setq en_data (entget (car en))) ;取得元体资料列表
(setq pt (cdr (assoc 10 en_data))) ;求得高程点坐标pt

(setq pz (nth 2 pt));提取测量坐标洗z值
(setq pz1 (rtos (nth 2 pt)));提取测量坐标系Z值
(setq i (+ i 1))
(setq zh (+ zh pz))
(setq pj (/ zh i))

(setq sn (rtos i 2 0))
(setq zh1 (rtos zh 2 3))
(setq pj1 (rtos pj 2 3))

(setq pdz (strcat "共拾取" sn "点,高程累计值:" zh1 ",高程平均值: "pj1)) ;输出为数据格式（高程，累计和，平均值）
(princ pdz)

)
)

skg123

修改后可以框选了，，借鉴了http://bbs.mjtd.com/thread-85363-1-1.html 中 的代码

2. (defun c:pjz(/ p1 p2 ss sn si i x y e fw)
   
3. (prompt "**从CASS中提取高程点计算高程累计和 和平均数，请在命令行输入 pjz **")
   
4. (setq sn 0)
   
5. (setq zh 0)
   
6.   (setq ss(ssget  (list(cons 8 "GCD")(cons 2 "GC200"))))
   
7. (if ss(progn
   
8.   (setq fw(open "d:\\ex.dat" "w"))
   
9.   (setq sn(sslength ss))
   
10.   (setq i 0)
    
11.   (while(< i sn)
    
12.    (setq si(ssname ss i))
    
13. ;=====提取坐标=================
    
14.    (setq pt(cdr(assoc 10 (entget si))))
    
15.    (setq x(rtos(car pt)2 3) y(rtos(cadr pt)2 3) e(rtos(caddr pt)2 3))
    
16.    (princ(strcat (itoa (1+ i))",GCD," x "," y "," e "\n") fw)
    
17.    (setq i(1+ i))
    
18. ;=====计算平均值==============
    
19. (setq pz (nth 2 pt));提取测量坐标洗z值
    
20. (setq pz1 (rtos (nth 2 pt)));提取测量坐标系Z值
    
21. (setq zh (+ zh pz))
    
22. (setq pj (/ zh i))
    
23. (setq si (rtos i 2 0))
    
24. (setq zh1 (rtos zh 2 3))
    
25. (setq pj1 (rtos pj 2 3))
    
26. (setq pdz (strcat "本次共拾取" si "点,高程累计值:" zh1 ",高程平均值: "pj1 ",坐标文件在D盘;")) ;输出为数据格式（高程，累计和，平均值）
    
27. 
    
28.   )
    
29.   (close fw)
    
30. 
    
31. ))
    
32. (princ pdz)
    
33. )

(defun c:pjz(/ p1 p2 ss sn si i x y e fw)<br /> (prompt "**从CASS中提取高程点计算高程累计和 和平均数，请在命令行输入 pjz **")<br /> (setq sn 0)<br /> (setq zh 0)<br />   (setq ss(ssget  (list(cons 8 "GCD")(cons 2 "GC200"))))<br /> (if ss(progn<br />   (setq fw(open "d:\\ex.dat" "w"))<br />   (setq sn(sslength ss))<br />   (setq i 0)<br />   (while(< i sn) <br />    (setq si(ssname ss i))<br /> ;=====提取坐标=================<br />    (setq pt(cdr(assoc 10 (entget si))))<br />    (setq x(rtos(car pt)2 3) y(rtos(cadr pt)2 3) e(rtos(caddr pt)2 3))<br />    (princ(strcat (itoa (1+ i))",GCD," x "," y "," e "\n") fw)<br />    (setq i(1+ i))<br /> ;=====计算平均值==============<br /> (setq pz (nth 2 pt));提取测量坐标洗z值<br /> (setq pz1 (rtos (nth 2 pt)));提取测量坐标系Z值<br /> (setq zh (+ zh pz))<br /> (setq pj (/ zh i))<br /> (setq si (rtos i 2 0))<br /> (setq zh1 (rtos zh 2 3))<br /> (setq pj1 (rtos pj 2 3))<br /> (setq pdz (strcat "本次共拾取" si "点,高程累计值:" zh1 ",高程平均值: "pj1 ",坐标文件在D盘;")) ;输出为数据格式（高程，累计和，平均值）<br /> <br />   )<br />   (close fw)<br /> <br /> ))<br /> (princ pdz)<br /> )

16699988885

更新代码本次共拾取31点, 高程平均值: 6.854, 最小高程: 6.621, 最大高程: 7.101, 坐标文件在D盘;"本次共拾取31点, 高程平均值: 6.854, 最小高程: 6.621, 最大高程:

1. (defun c:pjz (/ p1 p2 ss sn si i x y e fw)
   
2.   (prompt "\n**从CASS中提取高程点计算高程累计和 和平均数，请在命令行输入 pjz **")
   
3.   (setq sn 0) ; 初始化计数器
   
4.   (setq zh 0) ; 初始化高程累计和
   
5.   (setq ss (ssget (list (cons 8 "GCD") (cons 2 "GC200")))) ; 获取图层为GCD且名称为GC200的对象
   
6.   (if ss
   
7.     (progn
   
8.       (setq fw (open "d:\\ex.dat" "w")) ; 打开文件准备写入
   
9.       (setq sn (sslength ss)) ; 获取选择集中的对象数量
   
10.       (setq i 0) ; 初始化循环变量
    
11.       (while (< i sn)
    
12.         (setq si (ssname ss i)) ; 获取当前对象
    
13.         (setq pt (cdr (assoc 10 (entget si)))) ; 提取当前对象的3D坐标
    
14.         (setq x (rtos (car pt) 2 3)) ; X坐标
    
15.         (setq y (rtos (cadr pt) 2 3)) ; Y坐标
    
16.         (setq e (rtos (caddr pt) 2 3)) ; Z坐标（高程）
    
17.         
    
18.         (princ (strcat (itoa (1+ i)) ",GCD," x "," y "," e "\n") fw) ; 写入文件
    
19.         
    
20.         (setq pz (nth 2 pt)) ; 提取Z值
    
21.         (setq zh (+ zh pz)) ; 更新高程累计和
    
22.         (setq pj (/ zh (1+ i))) ; 计算当前平均值
    
23.         (setq si (rtos (1+ i) 2 0)) ; 当前点的数量
    
24.         (setq zh1 (rtos zh 2 3)) ; 高程累计和
    
25.         (setq pj1 (rtos pj 2 3)) ; 平均高程
    
26.         (setq pdz (strcat "本次共拾取" si "点, 高程累计值:" zh1 ", 高程平均值: " pj1 ", 坐标文件在D盘;"))
    
27.         
    
28.         (setq i (1+ i)) ; 更新循环变量
    
29.       )
    
30.       (close fw) ; 关闭文件
    
31.     )
    
32.   )
    
33.   (princ pdz) ; 输出结果到命令行
    
34. )

(defun c:pjz (/ p1 p2 ss sn si i x y e fw)<br />   (prompt "\n**从CASS中提取高程点计算高程累计和 和平均数，请在命令行输入 pjz **")<br />   (setq sn 0) ; 初始化计数器<br />   (setq zh 0) ; 初始化高程累计和<br />   (setq ss (ssget (list (cons 8 "GCD") (cons 2 "GC200")))) ; 获取图层为GCD且名称为GC200的对象<br />   (if ss<br />     (progn<br />       (setq fw (open "d:\\ex.dat" "w")) ; 打开文件准备写入<br />       (setq sn (sslength ss)) ; 获取选择集中的对象数量<br />       (setq i 0) ; 初始化循环变量<br />       (while (< i sn)<br />         (setq si (ssname ss i)) ; 获取当前对象<br />         (setq pt (cdr (assoc 10 (entget si)))) ; 提取当前对象的3D坐标<br />         (setq x (rtos (car pt) 2 3)) ; X坐标<br />         (setq y (rtos (cadr pt) 2 3)) ; Y坐标<br />         (setq e (rtos (caddr pt) 2 3)) ; Z坐标（高程）<br />         <br />         (princ (strcat (itoa (1+ i)) ",GCD," x "," y "," e "\n") fw) ; 写入文件<br />         <br />         (setq pz (nth 2 pt)) ; 提取Z值<br />         (setq zh (+ zh pz)) ; 更新高程累计和<br />         (setq pj (/ zh (1+ i))) ; 计算当前平均值<br />         (setq si (rtos (1+ i) 2 0)) ; 当前点的数量<br />         (setq zh1 (rtos zh 2 3)) ; 高程累计和<br />         (setq pj1 (rtos pj 2 3)) ; 平均高程<br />         (setq pdz (strcat "本次共拾取" si "点, 高程累计值:" zh1 ", 高程平均值: " pj1 ", 坐标文件在D盘;"))<br />         <br />         (setq i (1+ i)) ; 更新循环变量<br />       )<br />       (close fw) ; 关闭文件<br />     )<br />   )<br />   (princ pdz) ; 输出结果到命令行<br /> )

7.101, 坐标文件在D盘;"

willing0

感谢楼主无私奉献，受益匪浅！

杜阳

支持大师的源代码   学习了  测量界的大师啊

spp_wall

不错的东西！！！！

gzxl

2. (defun c:tt( / i L lst maxx maxy maxZ minx miny minZ pl pjZ sel ss x)
   
3.   (vl-load-com)
   
4.   (if (and (setq sel (entsel "\n请选择封闭范围线:"))
   
5.            (eq (cdr (assoc 0 (entget (car sel)))) "LWPOLYLINE")
   
6.            (vlax-curve-isClosed (vlax-ename->vla-object (car sel)))
   
7.       )
   
8.     (progn
   
9.        (setq lst  (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) (entget (car sel)))))
   
10.        (setq minX (apply 'min (mapcar '(lambda (x) (car x)) lst))
    
11.              minY (apply 'min (mapcar '(lambda (x) (cadr x)) lst))
    
12.              maxX (apply 'max (mapcar '(lambda (x) (car x)) lst))
    
13.              maxY (apply 'max (mapcar '(lambda (x) (cadr x)) lst))
    
14.        )
    
15.        (command "zoom" (list minX minY) (list maxX maxY))
    
16.        (setq ss (ssget "_CP" lst '((0 . "INSERT") (2 . "GC200"))))
    
17.        (if (and ss (> (sslength ss) 1))
    
18.          (progn
    
19.            (setq i 0 L (sslength ss))
    
20.            (repeat L
    
21.               (setq pl (cons (caddr (cdr (assoc 10 (entget (ssname ss i))))) pl)
    
22.                     i  (1+ i)
    
23.               )
    
24.            )
    
25.            (setq minZ (apply 'min pl)
    
26.                  maxZ (apply 'max pl)
    
27.                  pjZ  (/ (apply '+ pl) i)
    
28.            )
    
29.            (alert
    
30.              (strcat
    
31.                 "最大的高程值为：" (rtos maxZ 2 3)
    
32.                 "\n"
    
33.                 "最小的高程值为：" (rtos minZ 2 3)
    
34.                 "\n"
    
35.                 "平均的高程值为：" (rtos pjZ 2 3)
    
36.                 "\n"
    
37.                 "高程值的个数为：" (rtos i 2 0)
    
38.              )
    
39.            )
    
40.          )
    
41.          (alert "选择的区域范围无高程点！")
    
42.        )
    
43.     )
    
44.     (alert "所选的封闭线不是经量多义线！或 不闭合！")
    
45.   )
    
46.   (princ)
    
47. )

(defun c:tt( / i L lst maxx maxy maxZ minx miny minZ pl pjZ sel ss x)<br />   (vl-load-com)<br />   (if (and (setq sel (entsel "\n请选择封闭范围线:"))<br />            (eq (cdr (assoc 0 (entget (car sel)))) "LWPOLYLINE")<br />            (vlax-curve-isClosed (vlax-ename->vla-object (car sel)))<br />       )<br />     (progn<br />        (setq lst  (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) (entget (car sel)))))<br />        (setq minX (apply 'min (mapcar '(lambda (x) (car x)) lst))<br />              minY (apply 'min (mapcar '(lambda (x) (cadr x)) lst))<br />              maxX (apply 'max (mapcar '(lambda (x) (car x)) lst))<br />              maxY (apply 'max (mapcar '(lambda (x) (cadr x)) lst))<br />        )<br />        (command "zoom" (list minX minY) (list maxX maxY))<br />        (setq ss (ssget "_CP" lst '((0 . "INSERT") (2 . "GC200"))))<br />        (if (and ss (> (sslength ss) 1))<br />          (progn<br />            (setq i 0 L (sslength ss))<br />            (repeat L<br />               (setq pl (cons (caddr (cdr (assoc 10 (entget (ssname ss i))))) pl)<br />                     i  (1+ i)<br />               )<br />            )<br />            (setq minZ (apply 'min pl)<br />                  maxZ (apply 'max pl)<br />                  pjZ  (/ (apply '+ pl) i)<br />            )<br />            (alert<br />              (strcat<br />                 "最大的高程值为：" (rtos maxZ 2 3)<br />                 "\n"<br />                 "最小的高程值为：" (rtos minZ 2 3)<br />                 "\n"<br />                 "平均的高程值为：" (rtos pjZ 2 3)<br />                 "\n"<br />                 "高程值的个数为：" (rtos i 2 0)<br />              )<br />            )<br />          )<br />          (alert "选择的区域范围无高程点！")<br />        )<br />     )<br />     (alert "所选的封闭线不是经量多义线！或 不闭合！")<br />   )<br />   (princ)<br /> )

贴个类似的

skg123

gzxl 发表于 2014-6-20 11:40
贴个类似的

筛选出最大值和最小值，可以借鉴

zjsmlzp

很好！可用。顶～～～

染然柒

框选的不能用

树櫴希德

强烈支持，测绘界大师！！！

奕奕

很好 框选功能很实用cass下