明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 564|回复: 5

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

[复制链接]
发表于 2015-7-15 21:35 | 显示全部楼层 |阅读模式
[code="lisp] (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)
)[/code]
该贴已经同步到 树櫴希德的微博

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
 楼主| 发表于 2015-7-15 21:36 | 显示全部楼层
只为测绘简单些,用了各位大神的程序,请见谅
 楼主| 发表于 2015-7-15 23:18 | 显示全部楼层
73哥函数改进版

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
发表于 2015-7-17 08:32 | 显示全部楼层
感谢楼主经验分享,受益匪浅!
发表于 2015-8-6 20:47 | 显示全部楼层
同行。。谢谢
发表于 2017-12-12 21:02 | 显示全部楼层
用得少,谢谢分享
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2018-1-18 15:59 , Processed in 0.223115 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表