求一个能一次性提取N多个矩形4个角点坐标的程序，不胜感激！
本帖最后由 gsn611 于 2013-4-20 08:50 编辑提取到txt或者excel都行，最好是框选后矩形角点有顺序好，txt或者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)
) 一个古旧的Lisp，你可以试试。 ll_j 发表于 2013-4-19 17:52 static/image/common/back.gif
一个古旧的Lisp，你可以试试。
朋友首先感谢你回贴。我有个问题还请教，加载后提示这个是什么意思？而且使用时不是一次性提取N多个矩形到一个csv文件？ 使用时不是一次性提取N多个矩形到一个csv文件,而且不好用。 gsn611 发表于 2013-4-20 08:38 static/image/common/back.gif
朋友首先感谢你回贴。我有个问题还请教，加载后提示这个是什么意思？而且使用时不是一次性提取N多个矩形到 ...
这是以前的程序，早就忘了，昨天好不容易才找出来，使用很少，也不太想改了，如果你用得比较多，可以试试改一下，或者让大家改一下，否则还是算了。
这里显示的提示应该是“基点<0,0>: ”，可能是CAD版本的问题，显示错误。这个基点是控制图形相对坐标的，设定了基点后，输出的坐标值就是相对这个基点的坐标了。
对多条多段线（不仅仅是矩形）逐条使用，如果使用相同的输出文件名，结果是附加的。 ll_j 发表于 2013-4-20 10:15 static/image/common/back.gif
这是以前的程序，早就忘了，昨天好不容易才找出来，使用很少，也不太想改了，如果你用得比较多，可以试试 ...
朋友，我要是有自己修改的水平，我就不发帖了。我还是再等等看有提供现成能用的吧。 ll_j 发表于 2013-4-20 12:36 static/image/common/back.gif
朋友你的善举对我帮助很大，这里需要你这样有正能量的人。 新手，刚好需要这样的代码，谢谢了 :victory::handshake
页:
[1]