CAD批量提取矩形顶点坐标的l代码？
CAD批量提取矩形顶点坐标的代码，请高手指教。希望能提取多个矩形的对角点坐标，并导出到文本或者EXCEL。 群里找到一个可以提取四个点的程序。现在想只提取任意对角两个点的坐标。;;;多义线端点输出到文件0.91版
(defun c:sx (/ ss se e0 e1 en pt0 x0 y0 dph dn fn f)
(princ "\n多义线端点输出到文件。")
(princ "\n选择多义线：")
(setqss(ssget '((0 . "lwpolyline")))
len (sslength ss)
i -1
e0nil
)
(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)
) 不是csv么，excel打开了删掉不要的坐标就是了。
页:
[1]