cass高程点过滤保留点位，求改进 完美

树櫴希德

2. (defun xd-Clearcset (/ cset)
   
3.   (if (not (vl-catch-all-error-p
   
4.              (setq cset
   
5.                     (vl-catch-all-apply
   
6.                       'vla-item
   
7.                       (list
   
8.                         (vla-get-selectionsets
   
9.                           (vla-get-activedocument (vlax-get-acad-object)) ;_
   
10.                         )
    
11.                         "CURRENT"
    
12.                       )
    
13.                     )
    
14.              )
    
15.            )
    
16.       )
    
17.     (vla-delete cset)
    
18.   )
    
19.   (princ)
    
20. )
    
21. 
    
22. (defun xd-cset ()
    
23.   (setq        *doc  (vla-get-activedocument (vlax-get-acad-object))
    
24.         *sets (vla-get-selectionsets *doc)
    
25.   )
    
26.   (if (ssget "P")
    
27.     (vla-delete (vla-item *sets 0))
    
28.   )
    
29.   (vla-get-activeselectionset *doc)
    
30. )
    
31. 
    
32. (defun ai_deselect ()
    
33.   (if (= (getvar "cmdecho") 0) ;_start if
    
34.     (command "_.select" "_r" "_all" "")
    
35.     (progn ;_start progn for cmdecho 1
    
36.       (setvar "cmdecho" 0)
    
37.       (command "_.select" "_r" "_all" "")
    
38.       (setvar "cmdecho" 1)
    
39.     ) ;_end progn for cmdecho 1
    
40.   ) ;_end if
    
41.   ;;(terpri)
    
42.   ;;(prompt "所有对象都已取消选择")
    
43.   (princ)
    
44. )
    
45. 
    
46. (defun xdelatt (*cad / FIL SS *cad)
    
47.   (princ "\n 删除块属性----------by lxx.2007.9")
    
48.   (princ "\n 选择要删除属性的块<全部>:")
    
49.   ;(setq *cad (vlax-ename->vla-object (CAR(ENTSEL))))
    
50.   
    
51. 
    
52.     (setq *cad (vlax-get-acad-object))
    
53.   (xd-Clearcset);;;;;;;;;;;;;;;;;;;;;
    
54.   
    
55.   (setq fil '((0 . "INSERT") (-4 . "&") (66 . 1)))
    
56.   ;(or (setq ss (ssget fil))
    
57.       ;(setq ss (ssget "x" fil))
    
58.   ;)
    
59.   (vla-eval *cad
    
60.      "for each i in thisdrawing.activeselectionset : for each n in i.getattributes : n.delete :next n :next i"
    
61.   )
    
62.   
    
63. )
    
64. ;;;;;;;;;;;;;;;
    
65. (defun lst-(l1 l2)
    
66. (vl-remove-if'(lambda(x)(member x l2))l1))
    
67. 
    
68. 
    
69. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
70. (defun c:pjz(/ p1 p2 ss sn si i x y e fw pzxa pzxb pzxzx *cad)
    
71. (prompt "**从CASS中提取高程点计算高程累计和 和平均数，请在命令行输入 pjz **")
    
72. (setq sn 0)
    
73. (setq zh 0)
    
74.   (setq ss(ssget  (list(cons 8 "GCD")(cons 2 "GC200"))))
    
75. (if ss(progn
    
76.   (setq fw(open "d:\\ex.dat" "w"))
    
77.   (setq sn(sslength ss))
    
78.   (setq i 0)
    
79.   (while(< i sn)
    
80.    (setq si(ssname ss i))
    
81. ;=====提取坐标=================
    
82.    (setq pt(cdr(assoc 10 (entget si))))
    
83.    (setq x(rtos(car pt)2 3) y(rtos(cadr pt)2 3) e(rtos(caddr pt)2 3))
    
84.    (setq pzxa(list (atof x) (atof y) (atof e)))
    
85.     (setq pzxb (append pzxb (list pzxa)))
    
86. 
    
87. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
88. (defun delsameok(l1 rcz / l2);;带容差去重(重复过的取第一次出现)，有时处理坐标点需要考虑容差
    
89.   (while l1
    
90.     (setq l2(cons(car l1)l2)l1(vl-remove-if'(lambda (x)(equal(car l1)x rcz))(cdr l1))))
    
91.   (reverse l2))
    
92. ;;;;;;;;;;;;;;;;;;;;;;;;;
    
93.    
    
94.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
95. (defun delsame(l1 rcz / l2);;带容差去重(重复过的不出现)，有时处理坐标点需要考虑容差
    
96.   (while (setq l1(vl-remove-if'(lambda (x)(equal(car l1)x rcz))(cdr l1)))
    
97.     (setq l2(cons(car l1)l2)))
    
98.   (reverse l2))
    
99.     ;;;;;;;;;;;;;;;;;;;;;
    
100.    
     
101. 
     
102.    
     
103.    (princ(strcat (itoa (1+ i))",GCD," x "," y "," e "\n") fw)
     
104.    
     
105.    (setq i(1+ i))
     
106. ;=====计算平均值==============
     
107. (setq pz (nth 2 pt));提取测量坐标洗z值
     
108. (setq pz1 (rtos (nth 2 pt)));提取测量坐标系Z值
     
109. (setq zh (+ zh pz))
     
110. (setq pj (/ zh i))
     
111. (setq si (rtos i 2 0))
     
112. (setq zh1 (rtos zh 2 3))
     
113. (setq pj1 (rtos pj 2 3))
     
114. (setq pdz (strcat "本次共拾取" si "点,高程累计值:" zh1 ",高程平均值: "pj1 ",坐标文件在D盘;")) ;输出为数据格式（高程，累计和，平均值）
     
115. 
     
116.   )
     
117. (setq pzxzx (lst- pzxb (delsame pzxb 5)))
     
118.     (foreach n (lst- pzxb (delsame pzxb 5))
     
119. (xdelatt (setq *cad (ssget n)))
     
120. 
     
121.       )
     
122.   
     
123.   
     
124.   (close fw)
     
125. 
     
126. ))
     
127. (princ pdz)
     
128. )

(defun xd-Clearcset (/ cset)<br />   (if (not (vl-catch-all-error-p<br />              (setq cset<br />                     (vl-catch-all-apply<br />                       'vla-item<br />                       (list<br />                         (vla-get-selectionsets<br />                           (vla-get-activedocument (vlax-get-acad-object)) ;_<br />                         )<br />                         "CURRENT"<br />                       )<br />                     )<br />              )<br />            )<br />       )<br />     (vla-delete cset)<br />   )<br />   (princ)<br /> )<br /> <br /> (defun xd-cset ()<br />   (setq        *doc  (vla-get-activedocument (vlax-get-acad-object))<br />         *sets (vla-get-selectionsets *doc)<br />   )<br />   (if (ssget "P")<br />     (vla-delete (vla-item *sets 0))<br />   )<br />   (vla-get-activeselectionset *doc)<br /> )<br /> <br /> (defun ai_deselect ()<br />   (if (= (getvar "cmdecho") 0) ;_start if<br />     (command "_.select" "_r" "_all" "")<br />     (progn ;_start progn for cmdecho 1<br />       (setvar "cmdecho" 0)<br />       (command "_.select" "_r" "_all" "")<br />       (setvar "cmdecho" 1)<br />     ) ;_end progn for cmdecho 1<br />   ) ;_end if<br />   ;;(terpri)<br />   ;;(prompt "所有对象都已取消选择")<br />   (princ)<br /> )<br /> <br /> (defun xdelatt (*cad / FIL SS *cad)<br />   (princ "\n 删除块属性----------by lxx.2007.9")<br />   (princ "\n 选择要删除属性的块<全部>:")<br />   ;(setq *cad (vlax-ename->vla-object (CAR(ENTSEL))))<br />   <br /> <br />     (setq *cad (vlax-get-acad-object))<br />   (xd-Clearcset);;;;;;;;;;;;;;;;;;;;;<br />   <br />   (setq fil '((0 . "INSERT") (-4 . "&") (66 . 1)))<br />   ;(or (setq ss (ssget fil))<br />       ;(setq ss (ssget "x" fil))<br />   ;)<br />   (vla-eval *cad<br />      "for each i in thisdrawing.activeselectionset : for each n in i.getattributes : n.delete :next n :next i"<br />   )<br />   <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 pzxzx *cad)<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 />    (setq pzxa(list (atof x) (atof y) (atof e)))<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 /> (setq pzxzx (lst- pzxb (delsame pzxb 5)))<br />     (foreach n (lst- pzxb (delsame pzxb 5))<br /> (xdelatt (setq *cad (ssget n)))<br /> <br />       )<br />   <br />   <br />   (close fw)<br /> <br /> ))<br /> (princ pdz)<br /> )

该贴已经同步到 树櫴希德的微博

yxh1202

版主你好，可否实现抽稀功能。不要删除原数据

tonglesky

的风格地方根豆粉

lioun4105

用得少，谢谢分享

树櫴希德

只为测绘简单些，用了各位大神的程序，请见谅

树櫴希德

73哥函数改进版

lingfeng82

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

xujinhua

同行。。谢谢

whg587081

不错，非常感谢！

yoyoho

谢谢分享,学了!!!!

迷失1786

谢谢楼主分享