CASS中高程点坐标提取,CASS自带的高程提取是整体(全部)高程点提取,当用户需要选择性的提取时就不方便了,本程序针对该问题进行了修改。
命令:gcdtq
;By 2012-12-17 宜昌
(defun c:gcdtq()
(setvar "cmdecho" 0) ;指令执行过程不响应
(setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "a"))
(setq n 0)
(setq en t); 对象为T值,t为常量,非NiL值
(while en;循环语句
(while(not(setq en (entsel"\n选择高程点<Esc退出>: "))) ;没选中就一直让选择,取消键退出
en
);循环选择,过滤空选;
(redraw (car en) 3);亮显高程点
(setq n(+ n 1))
(setq pn(rtos n 2 0))
(setq en_data (entget (car en))) ;取得元体资料列表
(setq pt (cdr (assoc 10 en_data))) ;求得高程点坐标pt
(setq py(rtos (nth 1 pt)2 3));提取测量坐标Y值
(setq px(rtos (nth 0 pt)2 3));提取测量坐标X值
(setq pz(rtos (nth 2 pt)2 3));提取测量坐标Z值
(setq sxyz (strcat pn",,"px "," py "," pz))
(write-line sxyz ff)
(prin1)
(princ sxyz)
))
(prompt "***** << C:gcdtq >> ***提取高程点坐标输出为CASS格式****")
(close ff)
(prin1);
;从CASS中连续单选 高程点,并将高程点数据输出到文本,解决CASS不能有选择性的拾取高程点。
2014年8月30修改,修改后增加 高程点编码,可以框选,并且可以连续作业
(defun c:tqgc(/ p1 p2 ss sn si i x y e fw)
(prompt "**从CASS中提取高程点,请在命令行输入 tqgc , ** Esc 取消退出")
(setq n 0)
(setq sn 0)
(setq zh 0)
(setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "a"))
(while
(setq word (getstring "\请输入高程点编码:"))
(setq ss(ssget (list(cons 8 "GCD")(cons 2 "GC200"))))
(if ss(progn
(setq fw(open "d:\\ex.dat" "w"))
(setq sn(sslength ss))
(setq i 0)
(while(< i sn)
(setq si (ssname ss i))
;=====提取坐标=====2014-08-30======
(setq pt(cdr(assoc 10 (entget si))))
(setq x(rtos(car pt)2 3) y(rtos(cadr pt)2 3) e(rtos(caddr pt)2 3))
(princ(strcat (itoa (+ n (+ 1 i )))","word"," x "," y "," e "\n") ff)
(setq i (+ 1 i))
);end while
(setq n (+ n sn ));序号累加
);end while
(close ff)
)
)
(princ)
)