CASS高程点 属性快过滤问题
在CASS中，高程点过滤一般采用距离过滤 高程值过滤方法 ，有时是在测量图中，坎上 坎下点太密就根据距离过滤掉了，但是算土石方时又需要用，能否解码CASS高程点过滤，改为过滤点缩小比列或者移至“过滤高程点”图层，或者把过滤点（属性快）文字删除，保留点位，请大家探讨下。(defun clearatt (entname / obj att atts)
(setq obj (vlax-ename->vla-object entname) )
(if (= (vla-get-objectName obj) "AcDbBlockReference")
(if (= (vla-get-hasattributes obj) :vlax-true)
(progn
(setq atts (vlax-safearray->list
(vlax-variant-value (vla-getattributes obj))
)
)
(foreach att atts
;;; (vla-put-textstring att "")
;;; (vla-update att)
(vla-delete att)
)
)
) ;if
)
)
;;;;;;;=========================================================================
(gc)
(alert "\n块原地过滤缩小命令PJZ")
;(command "_.layer" "s" "0" "off" "~TFT-GCD" "y" "")
(defun sstolst (ss)
(vl-remove-if-not
'(lambda (x) (equal (type x) 'ename))
(mapcar 'cadr (ssnamex ss))
)
)
(defun deld(lst d / a b c)
(while(setq a(mapcar'+(car lst)'(0 0))
b(vl-remove-if'(lambda(x)(>(distance a x)d))(cdr lst))
lst(lst-(cdr lst)b))
(setq c(cons b c))
)
(apply'append c))
;;;;;;;;;;;;;;;
(defun lst-(l1 l2)
(vl-remove-if'(lambda(x)(member x l2))l1))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:pjz(/ p1 p2 ss sn si i x y e fw pzxa pzxb pzx1zx pzxoku n pzx121 ptlst beishu ss_name ss_att ss_name_xy ssn)
;(setq beishu(GETREAL "\n请输入缩放倍数(非负且大于0):"))
(prompt "**从CASS中提取高程点计算高程累计和 和平均数，请在命令行输入 pjz **")
(setvar "osmode" 16384)
(setq sn 0)
(setq zh 0)
(setq ss(ssget(list '(0 . "insert"))))
(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))
;=====提取坐标=================
(setq pt(cdr(assoc 10 (entget si))))
(setq x(rtos(car pt)2 7) y(rtos(cadr pt)2 7) e(rtos(caddr pt)2 7))
(setq pzxa(list (car pt) (cadr pt) (caddr pt)))
(setq pzxb (append pzxb (list pzxa)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun delsameok(l1 rcz / l2);;带容差去重(重复过的取第一次出现)，有时处理坐标点需要考虑容差
(while l1
(setq l2(cons(car l1)l2)l1(vl-remove-if'(lambda (x)(equal(car l1)x rcz))(cdr l1))))
(reverse l2))
;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun delsame(l1 rcz / l2);;带容差去重(重复过的不出现)，有时处理坐标点需要考虑容差
(while (setq l1(vl-remove-if'(lambda (x)(equal(car l1)x rcz))(cdr l1)))
(setq l2(cons(car l1)l2)))
(reverse l2))
;;;;;;;;;;;;;;;;;;;;;
(princ(strcat (itoa (1+ i))",GCD," x "," y "," e "\n") fw)
(setq i(1+ i))
;=====计算平均值==============
(setq pz (nth 2 pt));提取测量坐标洗z值
(setq pz1 (rtos (nth 2 pt)));提取测量坐标系Z值
(setq zh (+ zh pz))
(setq pj (/ zh i))
(setq si (rtos i 2 0))
(setq zh1 (rtos zh 2 3))
(setq pj1 (rtos pj 2 3))
(setq pdz (strcat "本次共拾取" si "点,高程累计值:" zh1 ",高程平均值: "pj1 ",坐标文件在D盘;")) ;输出为数据格式（高程，累计和，平均值）
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq ptlst (vl-sort pzxb
;以下根据x坐标对表排序
'(lambda (e1 e2)
(< (car e1) (car e2) )
(< (cadr e1) (cadr e2) ) ) ) )
;;;;;;;;;;;;;;;;;-----------------------------------
(setq pzxzx (deld ptlst (getreal "\n请输入过滤点间距<5米>:")
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(foreach n pzxzx
;(xdelatt (setq pzxoku (ssget "c" (polar n 3.927 0.5) (polar n 0.785 0.5)) ) )
;(setq pzx121(car (sstolst (ssget "c" (polar n 3.927 0.00001) (polar n 0.785 0.00001)))))
(setq ssn 0)
(repeat (sslength ss)
(setq ss_name (ssname ss ssn))
(setq ss_att (entget ss_name))
(setq ss_name_xy (cdr (assoc '10 ss_att)))
;(setq pt_ss_dis (distance pt ss_name_xy))
(if (equal n ss_name_xy)
;(vla-ScaleEntity (vlax-ename->vla-object ss_name) (vla-get-InsertionPoint (vlax-ename->vla-object ss_name)) beishu)
(clearatt ss_name)
;(setq ss (ssdel ss_name ss))
)(setq ssn (1+ ssn))
)
;(entmod (append (vl-remove-if '(lambda(x) (member (car x) '(41 42 43))) pzx121)(list '(41 . 0.02) '(42 . 0.02) '(43 . 0.02) )))
;(command "_.scale" (ssget "c" (polar n 3.927 0.00001) (polar n 0.785 0.00001)) "" n "0.25")
;(command "_.circle" n "2")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; (sssetfirst nil (ssget pzxpzx))
(close fw)
))
(princ pdz)
)看看效果怎么样 73哥函数
实际上还可以通过展点号把所有点的点位都展绘出来（不是高程点，但有高程值），这样就可以根据需要把过滤掉的高程点找出来 llsheng_73 发表于 2015-7-8 17:47 static/image/common/back.gif
实际上还可以通过展点号把所有点的点位都展绘出来（不是高程点，但有高程值），这样就可以根据需要把过滤掉 ...
就是一个一个找太慢 CASS当时没有想到这点 所以求源码 不过这个问题值得讨论啊 高程点过滤不是太科学
本帖最后由 llsheng_73 于 2015-7-13 21:31 编辑
既然要计算土石方，直接把所有高程点全展绘出来不就了事了？
毕竟土石方测量和地形图测量不一样，不会强求测点分布均匀 llsheng_73 发表于 2015-7-13 21:29 static/image/common/back.gif
既然要计算土石方，直接把所有高程点全展绘出来不就了事了？
毕竟土石方测量和地形图测量不一样，不会强求 ...
不是。有些图甲方既要图面漂亮，又要高程多。不得不删除部分高程注记完美图面。主要用于整理图面。删除块属性文字的函数我已经找到了 (defun xdelatt (PZX / FIL SS)
(princ "\n 删除块属性----------by lxx.2007.9")
(princ "\n 选择要删除属性的块<全部>:")
(if (not *cad)
(setq *cad (vlax-get-acad-object))
)
;(x-CleanCSet)
(setq fil '((0 . "INSERT") (-4 . "&") (66 . 1)))
(or (setq ss (ssget fil))
(setq ss (ssget "x" fil))
)
(vla-eval *cad
"for each i in thisdrawing.activeselectionset : for each n in i.getattributes : n.delete :next n :next i"
)
)
(setq pzx (SSGET ))
(xdelatt PZX) 感谢楼主经验分享，受益匪浅！ 地形图中照样要用,删除定向检查点,等测重的点.
页:
[1]