CASS高程点 属性快过滤问题

树櫴希德

在CASS中，高程点过滤一般采用距离过滤 高程值过滤方法 ，有时是在测量图中，坎上 坎下点太密就根据距离过滤掉了，但是算土石方时又需要用，能否解码CASS高程点过滤，改为过滤点缩小比列或者移至“过滤高程点”图层，或者把过滤点（属性快）文字删除，保留点位，请大家探讨下。

树櫴希德

2. 
   
3. (defun clearatt (entname / obj att atts)
   
4. (setq obj (vlax-ename->vla-object entname) )
   
5. 
   
6. (if (= (vla-get-objectName obj) "AcDbBlockReference")
   
7.       (if (= (vla-get-hasattributes obj) :vlax-true)
   
8. (progn
   
9.    (setq atts (vlax-safearray->list
   
10.          (vlax-variant-value (vla-getattributes obj))
    
11.        )
    
12.    )
    
13.    (foreach att atts
    
14. ;;;     (vla-put-textstring att "")
    
15. ;;;     (vla-update att)
    
16.      (vla-delete att)
    
17.    )
    
18. )
    
19.       )     ;if
    
20.     )
    
21. 
    
22. )
    
23. ;;;;;;;=========================================================================
    
24. 
    
25. (gc)
    
26. (alert "\n块原地过滤缩小命令PJZ")
    
27. ;(command "_.layer" "s" "0" "off" "~TFT-GCD" "y" "")
    
28. 
    
29. (defun sstolst (ss)
    
30.   (vl-remove-if-not
    
31.     '(lambda (x) (equal (type x) 'ename))
    
32.     (mapcar 'cadr (ssnamex ss))
    
33.   )
    
34. )
    
35. 
    
36. 
    
37. (defun deld(lst d / a b c)
    
38.   (while(setq a(mapcar'+(car lst)'(0 0))
    
39.         b(vl-remove-if'(lambda(x)(>(distance a x)d))(cdr lst))
    
40.         lst(lst-(cdr lst)b))
    
41.     (setq c(cons b c))
    
42.     )
    
43.   (apply'append c))
    
44. 
    
45. ;;;;;;;;;;;;;;;
    
46. (defun lst-(l1 l2)
    
47. (vl-remove-if'(lambda(x)(member x l2))l1))
    
48. 
    
49. 
    
50. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
51. (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)
    
52.   ;(setq beishu(GETREAL "\n请输入缩放倍数(非负且大于0):"))
    
53. (prompt "**从CASS中提取高程点计算高程累计和 和平均数，请在命令行输入 pjz **")
    
54.   (setvar "osmode" 16384)
    
55. (setq sn 0)
    
56. (setq zh 0)
    
57.   (setq ss(ssget  (list '(0 . "insert")  )))
    
58. (if ss(progn
    
59.   (setq fw(open "d:\\ex.dat" "w"))
    
60.   (setq sn(sslength ss))
    
61.   (setq i 0)
    
62.   (while(< i sn)
    
63.    (setq si(ssname ss i))
    
64. ;=====提取坐标=================
    
65.    (setq pt(cdr(assoc 10 (entget si))))
    
66.    (setq x(rtos(car pt)2 7) y(rtos(cadr pt)2 7) e(rtos(caddr pt)2 7))
    
67.    (setq pzxa(list (car pt) (cadr pt) (caddr pt)))
    
68.     (setq pzxb (append pzxb (list pzxa)))
    
69. 
    
70. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
71. (defun delsameok(l1 rcz / l2);;带容差去重(重复过的取第一次出现)，有时处理坐标点需要考虑容差
    
72.   (while l1
    
73.     (setq l2(cons(car l1)l2)l1(vl-remove-if'(lambda (x)(equal(car l1)x rcz))(cdr l1))))
    
74.   (reverse l2))
    
75. ;;;;;;;;;;;;;;;;;;;;;;;;;
    
76.    
    
77.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
78. (defun delsame(l1 rcz / l2);;带容差去重(重复过的不出现)，有时处理坐标点需要考虑容差
    
79.   (while (setq l1(vl-remove-if'(lambda (x)(equal(car l1)x rcz))(cdr l1)))
    
80.     (setq l2(cons(car l1)l2)))
    
81.   (reverse l2))
    
82.     ;;;;;;;;;;;;;;;;;;;;;
    
83.    
    
84. 
    
85.    
    
86.    (princ(strcat (itoa (1+ i))",GCD," x "," y "," e "\n") fw)
    
87.    
    
88.    (setq i(1+ i))
    
89. ;=====计算平均值==============
    
90. (setq pz (nth 2 pt));提取测量坐标洗z值
    
91. (setq pz1 (rtos (nth 2 pt)));提取测量坐标系Z值
    
92. (setq zh (+ zh pz))
    
93. (setq pj (/ zh i))
    
94. (setq si (rtos i 2 0))
    
95. (setq zh1 (rtos zh 2 3))
    
96. (setq pj1 (rtos pj 2 3))
    
97. (setq pdz (strcat "本次共拾取" si "点,高程累计值:" zh1 ",高程平均值: "pj1 ",坐标文件在D盘;")) ;输出为数据格式（高程，累计和，平均值）
    
98. 
    
99.   )
    
100.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
101. (setq ptlst (vl-sort pzxb
     
102.                    ;以下根据x坐标对表排序
     
103.    '(lambda (e1 e2)
     
104.             (< (car e1) (car e2) )
     
105.       (< (cadr e1) (cadr e2) )   )   )    )
     
106. ;;;;;;;;;;;;;;;;;-----------------------------------
     
107. (setq pzxzx (deld ptlst (getreal "\n请输入过滤点间距<5米>:")
     
108. ))
     
109. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
110.   (foreach n pzxzx
     
111. ;(xdelatt (setq pzxoku (ssget "c" (polar n 3.927 0.5) (polar n 0.785 0.5))         )   )
     
112. 
     
113. ;(setq pzx121  (car (sstolst (ssget "c" (polar n 3.927 0.00001) (polar n 0.785 0.00001)))))
     
114. (setq ssn 0)
     
115.     (repeat (sslength ss)
     
116.          (setq ss_name (ssname ss ssn))
     
117.          (setq ss_att (entget ss_name))
     
118.          (setq ss_name_xy (cdr (assoc '10 ss_att)))
     
119.          ;(setq pt_ss_dis (distance pt ss_name_xy))
     
120.          (if (equal n ss_name_xy)
     
121.      ;(vla-ScaleEntity (vlax-ename->vla-object ss_name) (vla-get-InsertionPoint (vlax-ename->vla-object ss_name)) beishu)
     
122.      (clearatt ss_name)
     
123.      ;(setq ss (ssdel ss_name ss))
     
124.          
     
125.          )(setq ssn (1+ ssn))
     
126.        )
     
127. 
     
128.    
     
129. 
     
130. ;(entmod (append (vl-remove-if '(lambda(x) (member (car x) '(41 42 43))) pzx121)  (list '(41 . 0.02) '(42 . 0.02) '(43 . 0.02) )))
     
131. 
     
132.    
     
133.       ;(command "_.scale" (ssget "c" (polar n 3.927 0.00001) (polar n 0.785 0.00001)) "" n "0.25")
     
134.       ;(command "_.circle" n "2")
     
135. 
     
136.       )
     
137. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
138. ; (sssetfirst nil (ssget pzxpzx))
     
139.   (close fw)
     
140. 
     
141. ))
     
142. (princ pdz)
     
143. )

<br /> (defun clearatt (entname / obj att atts)<br /> (setq obj (vlax-ename->vla-object entname) )<br /> <br /> (if (= (vla-get-objectName obj) "AcDbBlockReference")<br />       (if (= (vla-get-hasattributes obj) :vlax-true)<br /> (progn<br />    (setq atts (vlax-safearray->list<br />          (vlax-variant-value (vla-getattributes obj))<br />        )<br />    )<br />    (foreach att atts<br /> ;;;     (vla-put-textstring att "")<br /> ;;;     (vla-update att)<br />      (vla-delete att)<br />    )<br /> )<br />       )     ;if<br />     )<br /> <br /> )<br /> ;;;;;;;=========================================================================<br /> <br /> (gc)<br /> (alert "\n块原地过滤缩小命令PJZ")<br /> ;(command "_.layer" "s" "0" "off" "~TFT-GCD" "y" "")<br /> <br /> (defun sstolst (ss)<br />   (vl-remove-if-not<br />     '(lambda (x) (equal (type x) 'ename))<br />     (mapcar 'cadr (ssnamex ss))<br />   )<br /> )<br /> <br /> <br /> (defun deld(lst d / a b c)<br />   (while(setq a(mapcar'+(car lst)'(0 0))<br />         b(vl-remove-if'(lambda(x)(>(distance a x)d))(cdr lst))<br />         lst(lst-(cdr lst)b))<br />     (setq c(cons b c))<br />     )<br />   (apply'append c))<br /> <br /> ;;;;;;;;;;;;;;;<br /> (defun lst-(l1 l2)<br /> (vl-remove-if'(lambda(x)(member x l2))l1))<br /> <br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (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)<br />   ;(setq beishu(GETREAL "\n请输入缩放倍数(非负且大于0):"))<br /> (prompt "**从CASS中提取高程点计算高程累计和 和平均数，请在命令行输入 pjz **")<br />   (setvar "osmode" 16384)<br /> (setq sn 0)<br /> (setq zh 0)<br />   (setq ss(ssget  (list '(0 . "insert")  )))<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 7) y(rtos(cadr pt)2 7) e(rtos(caddr pt)2 7))<br />    (setq pzxa(list (car pt) (cadr pt) (caddr pt)))<br />     (setq pzxb (append pzxb (list pzxa)))<br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun delsameok(l1 rcz / l2);;带容差去重(重复过的取第一次出现)，有时处理坐标点需要考虑容差<br />   (while l1<br />     (setq l2(cons(car l1)l2)l1(vl-remove-if'(lambda (x)(equal(car l1)x rcz))(cdr l1))))<br />   (reverse l2))<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;<br />     <br />     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun delsame(l1 rcz / l2);;带容差去重(重复过的不出现)，有时处理坐标点需要考虑容差<br />   (while (setq l1(vl-remove-if'(lambda (x)(equal(car l1)x rcz))(cdr l1)))<br />     (setq l2(cons(car l1)l2)))<br />   (reverse l2))<br />     ;;;;;;;;;;;;;;;;;;;;;<br />     <br /> <br />     <br />    (princ(strcat (itoa (1+ i))",GCD," x "," y "," e "\n") fw)<br />     <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 />   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (setq ptlst (vl-sort pzxb<br />                    ;以下根据x坐标对表排序<br />    '(lambda (e1 e2)<br />             (< (car e1) (car e2) )<br />       (< (cadr e1) (cadr e2) )   )   )    )<br /> ;;;;;;;;;;;;;;;;;-----------------------------------<br /> (setq pzxzx (deld ptlst (getreal "\n请输入过滤点间距<5米>:") <br /> ))<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br />   (foreach n pzxzx<br /> ;(xdelatt (setq pzxoku (ssget "c" (polar n 3.927 0.5) (polar n 0.785 0.5))         )   )<br /> <br /> ;(setq pzx121  (car (sstolst (ssget "c" (polar n 3.927 0.00001) (polar n 0.785 0.00001)))))<br /> (setq ssn 0)<br />     (repeat (sslength ss)<br />          (setq ss_name (ssname ss ssn))<br />          (setq ss_att (entget ss_name))<br />          (setq ss_name_xy (cdr (assoc '10 ss_att)))<br />          ;(setq pt_ss_dis (distance pt ss_name_xy))<br />          (if (equal n ss_name_xy)<br />      ;(vla-ScaleEntity (vlax-ename->vla-object ss_name) (vla-get-InsertionPoint (vlax-ename->vla-object ss_name)) beishu)<br />      (clearatt ss_name)<br />      ;(setq ss (ssdel ss_name ss))<br />          <br />          )(setq ssn (1+ ssn))<br />        )<br /> <br />     <br /> <br /> ;(entmod (append (vl-remove-if '(lambda(x) (member (car x) '(41 42 43))) pzx121)  (list '(41 . 0.02) '(42 . 0.02) '(43 . 0.02) )))<br /> <br />     <br />       ;(command "_.scale" (ssget "c" (polar n 3.927 0.00001) (polar n 0.785 0.00001)) "" n "0.25")<br />       ;(command "_.circle" n "2")<br /> <br />       )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; <br /> ; (sssetfirst nil (ssget pzxpzx))<br />   (close fw)<br /> <br /> ))<br /> (princ pdz)<br /> )

看看效果怎么样 73哥函数

llsheng_73

实际上还可以通过展点号把所有点的点位都展绘出来（不是高程点，但有高程值），这样就可以根据需要把过滤掉的高程点找出来

树櫴希德

llsheng_73 发表于 2015-7-8 17:47
实际上还可以通过展点号把所有点的点位都展绘出来（不是高程点，但有高程值），这样就可以根据需要把过滤掉 ...

就是一个一个找太慢 CASS当时没有想到这点 所以求源码

杜阳

不过这个问题值得讨论啊   高程点过滤不是太科学  

llsheng_73

既然要计算土石方，直接把所有高程点全展绘出来不就了事了？
毕竟土石方测量和地形图测量不一样，不会强求测点分布均匀

树櫴希德

llsheng_73 发表于 2015-7-13 21:29
既然要计算土石方，直接把所有高程点全展绘出来不就了事了？
毕竟土石方测量和地形图测量不一样，不会强求 ...

不是。有些图甲方既要图面漂亮，又要高程多。不得不删除部分高程注记完美图面。主要用于整理图面。删除块属性文字的函数我已经找到了

树櫴希德

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

lingfeng82

感谢楼主经验分享，受益匪浅！

004

地形图中照样要用,删除定向检查点,等测重的点.