求一个能一次性提取N多个矩形4个角点坐标的程序，不胜感激！

gsn611 · 发表于 2013-4-19 16:58:15

本帖最后由 gsn611 于 2013-4-20 08:50 编辑

提取到txt或者excel都行，最好是框选后矩形角点有顺序好，txt或者excel那也有顺序号。谁能帮我，谢谢。

ll_j · 发表于 2013-4-20 12:36:21

;;;多义线端点输出到文件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)
)

;;;多义线端点输出到文件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) 
)

ll_j · 发表于 2013-4-19 17:52:53

一个古旧的Lisp，你可以试试。

gsn611 · 发表于 2013-4-20 08:38:28

ll_j 发表于 2013-4-19 17:52
一个古旧的Lisp，你可以试试。

朋友首先感谢你回贴。我有个问题还请教，加载后提示这个是什么意思？而且使用时不是一次性提取N多个矩形到一个csv文件？

香田里浪人 · 发表于 2013-4-20 09:50:15

使用时不是一次性提取N多个矩形到一个csv文件,而且不好用。

ll_j · 发表于 2013-4-20 10:15:41

gsn611 发表于 2013-4-20 08:38
朋友首先感谢你回贴。我有个问题还请教，加载后提示这个是什么意思？而且使用时不是一次性提取N多个矩形到 ...

这是以前的程序，早就忘了，昨天好不容易才找出来，使用很少，也不太想改了，如果你用得比较多，可以试试改一下，或者让大家改一下，否则还是算了。
这里显示的提示应该是“基点<0,0>: ”，可能是CAD版本的问题，显示错误。这个基点是控制图形相对坐标的，设定了基点后，输出的坐标值就是相对这个基点的坐标了。
对多条多段线（不仅仅是矩形）逐条使用，如果使用相同的输出文件名，结果是附加的。

gsn611 · 发表于 2013-4-20 10:52:00

ll_j 发表于 2013-4-20 10:15
这是以前的程序，早就忘了，昨天好不容易才找出来，使用很少，也不太想改了，如果你用得比较多，可以试试 ...

朋友，我要是有自己修改的水平，我就不发帖了。我还是再等等看有提供现成能用的吧。

gsn611 · 发表于 2013-4-20 14:37:07

ll_j 发表于 2013-4-20 12:36

朋友你的善举对我帮助很大，这里需要你这样有正能量的人。

1633712236 · 发表于 2016-2-19 15:00:38

新手，刚好需要这样的代码，谢谢了

bodhi_li · 发表于 2018-1-2 22:57:12

账号		自动登录	找回密码
密码			注册

[源码] 求一个能一次性提取N多个矩形4个角点坐标的程序，不胜感激！

相关帖子

本帖子中包含更多资源

本帖子中包含更多资源