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

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 /> )

willing0

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

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下