cass高程点过滤保留点位，求改进 完美
(defun xd-Clearcset (/ cset)(if (not (vl-catch-all-error-p
(setq cset
(vl-catch-all-apply
'vla-item
(list
(vla-get-selectionsets
(vla-get-activedocument (vlax-get-acad-object)) ;_
)
"CURRENT"
)
)
)
)
)
(vla-delete cset)
)
(princ)
)
(defun xd-cset ()
(setq *doc(vla-get-activedocument (vlax-get-acad-object))
*sets (vla-get-selectionsets *doc)
)
(if (ssget "P")
(vla-delete (vla-item *sets 0))
)
(vla-get-activeselectionset *doc)
)
(defun ai_deselect ()
(if (= (getvar "cmdecho") 0) ;_start if
(command "_.select" "_r" "_all" "")
(progn ;_start progn for cmdecho 1
(setvar "cmdecho" 0)
(command "_.select" "_r" "_all" "")
(setvar "cmdecho" 1)
) ;_end progn for cmdecho 1
) ;_end if
;;(terpri)
;;(prompt "所有对象都已取消选择")
(princ)
)
(defun xdelatt (*cad / FIL SS *cad)
(princ "\n 删除块属性----------by lxx.2007.9")
(princ "\n 选择要删除属性的块<全部>:")
;(setq *cad (vlax-ename->vla-object (CAR(ENTSEL))))
(setq *cad (vlax-get-acad-object))
(xd-Clearcset);;;;;;;;;;;;;;;;;;;;;
(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"
)
)
;;;;;;;;;;;;;;;
(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 pzxzx *cad)
(prompt "**从CASS中提取高程点计算高程累计和 和平均数，请在命令行输入 pjz **")
(setq sn 0)
(setq zh 0)
(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))
;=====提取坐标=================
(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))
(setq pzxa(list (atof x) (atof y) (atof e)))
(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 pzxzx (lst- pzxb (delsame pzxb 5)))
(foreach n (lst- pzxb (delsame pzxb 5))
(xdelatt (setq *cad (ssget n)))
)
(close fw)
))
(princ pdz)
)
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 树櫴希德的微博 版主你好，可否实现抽稀功能。不要删除原数据 的风格地方根豆粉 用得少，谢谢分享 只为测绘简单些，用了各位大神的程序，请见谅 73哥函数改进版
感谢楼主经验分享，受益匪浅！ 同行。。谢谢 不错，非常感谢！ 谢谢分享,学了!!!! 谢谢楼主分享
页:
[1]
2