CAD批量提取矩形顶点坐标的l代码？

bodhi_li

CAD批量提取矩形顶点坐标的代码，请高手指教。希望能提取多个矩形的对角点坐标，并导出到文本或者EXCEL。

bodhi_li

群里找到一个可以提取四个点的程序。现在想只提取任意对角两个点的坐标。
;;;多义线端点输出到文件0.91版
(defun c:sx (/ ss se e0 e1 en pt0 x0 y0 dph dn fn f)
  (princ "\n多义线端点输出到文件。")
  (princ "\n选择多义线：")
  (setq  ss  (ssget '((0 . "lwpolyline")))
  len (sslength ss)
  i   -1
  e0  nil
  )
  (initget 129 " ")
  (setq pt0 (getpoint "\n坐标基点<0,0>："))
  (if pt0
    (if  (/= pt0 "")
      (setq x0 (car pt0)
      y0 (cadr pt0)
      )
      (setq x0 0.0
      y0 0.0
      )
    )
  )
  (repeat len
    (setq en (entget (ssname ss (setq i (1+ i))))
    e1 nil
    )
    (while en
      (if (= (caar en) 10)
  (setq e1 (cons (trans (cdar en) 0 1) e1)
        en (cdr en)
  )
  (setq en (cdr en))
      )
    )
    (setq e0 (cons e1 e0))
  )
  (if e0
    (setq dPh (getvar "dwgprefix")
    dn  (getvar "dwgname")
    dn  (strcat (substr dn 1 (- (strlen dn) 4)) ".csv")
    fn  (getfiled "多义线端点输出" (strcat dph dn) "csv" 9)
    f   (open fn "a")
    )
  )
  (if fn
    (progn
      (mapcar
  '(lambda (x)
     (if (> (caar x) (caar (reverse x)))
       (setq x (reverse x))
     )
     (princ "线形\n" f)
     (mapcar
       '(lambda (y)
    (princ (- (car y) x0) f)
    (princ "," f)
    (princ (- (cadr y) y0) f)
    (princ "\n" f)
        )
       x
     )
   )
  e0
      )
      (close f)
    )
  )
  (princ)
)

mikewolf2k

不是csv么，excel打开了删掉不要的坐标就是了。