提取点/线坐标

persuing

写了个提取点/线坐标的Lisp程序，还没有特别完善，先在这分享大家，应该可以直接复制使用
(defun c:ZBTQ()
(setq i 0 m 0  yxz nil Boint nil )
(setq S(getint "\n选择模式(1)点(2)线："))
(setq ss (ssget))
(setq OF(open(getfiled "文件保存为" "C:/users/administrator/desktop/" "dat" 1) "W"))
(setq n (sslength ss));选择集
(cond
      ((= S 1)
       (repeat n
             (setq spt (ssname ss i))
             (setq ept (entget spt))
             (if (= (cdr(assoc 0 ept)) "POINT")
               (progn
                     (setq yxz(cdr(assoc 10 ept)))
                     (setq y(nth 0 yxz))
                     (setq x(nth 1 yxz))
                     (setq z(nth 2 yxz))
                     (setq Boint(append Boint (list(list y x z))));目的是先将坐标数据统一放置一个表，方便删除重复项
               )
             )
             (setq i (+ 1 i))
       )      
      )
      ((= S 2)
       (repeat n
              (setq spt(ssname ss i))
              (setq ept(entget spt))
              (if(= (cdr(assoc 0 ept)) "LWPOLYLINE");二维多段线
                 (progn
                       (foreach zb ept
                               (if(=(car zb) 10)
                                  (progn
                                        (setq y(car(cdr zb)) x(car(cdr(cdr zb))))
                                        (setq Boint(append Boint (list(list y x 0.000))))
                                  )
                               )
                       )
                 )
              )
              (if(=(cdr(assoc 0 ept)) "LINE");直线
                 (progn
                       (setq Spoint(assoc 10 ept) Epoint(assoc 11 ept))
                       (setq y(car(cdr Spoint))  x(car(cdr(cdr Spoint))) z(car(cdr(cdr(cdr Spoint)))))
                       (setq Boint(append Boint (list(list y x z))))
                       (setq y(car(cdr Epoint)) x(car(cdr(cdr Epoint))) z(car(cdr(cdr(cdr Epoint)))))
                       (setq Boint(append Boint (list(list y x z))))
                 )
              )
              (if(=(cdr(assoc 0 ept)) "POLYLINE");多段线                  
                 (progn
                       (setq b 0)
                       (setq Name(vlax-get(vlax-ename->vla-object spt) "ObjectName"))
                       (if(= Name "AcDb2dPolyline")
                          (progn
                            (setq point(vlax-get(vlax-ename->vla-object  spt) "Coordinates") H(vlax-get(vlax-ename->vla-object spt) "Elevation"));将图元转化为vla对象
                               (setq a(/(length point) 3) );顶点数
                               (repeat a
                                     (setq y(nth b point) x(nth (+ 1 b) point))
                                     (setq Boint(append Boint (list(list y x H))))
                                     (setq b(+ 3 b))
                               )
                          )
                        )
                        (if(= Name "AcDb3dPolyline")
                          (progn
                                (setq point(vlax-get(vlax-ename->vla-object spt) "Coordinates"))
                                (setq a(/(length point) 3));定点数
                                (repeat a
                                      (setq y(nth b point) x(nth (+ 1 b) point) z(nth (+ 2 b) point))
                                      (setq Boint(append Boint (list(list y x z))))
                                      (setq b(+ 3 b))
                                )
                          )
                         )
                 )
              )
              (setq i(+ 1 i))
      )
     )
)
  ;删除表中重复坐标
(while Boint
       (setq m(+ 1 m) s(rtos m 2 0))
       (setq y(rtos (car(car Boint)) 2 3) x(rtos (car(cdr(car Boint))) 2 3) z(rtos (car(cdr(cdr(car Boint)))) 2 3))
       (setq syxz(strcat s ",," y "," x "," z))
       (write-line syxz OF)
       (setq Boint(vl-remove (car Boint) Boint))
)   
(close OF)
)