明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 173|回复: 2

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

[复制链接]
发表于 2018-1-2 22:37 | 显示全部楼层 |阅读模式
CAD批量提取矩形顶点坐标的代码,请高手指教。希望能提取多个矩形的对角点坐标,并导出到文本或者EXCEL。
 楼主| 发表于 2018-1-2 23:14 | 显示全部楼层
群里找到一个可以提取四个点的程序。现在想只提取任意对角两个点的坐标。
;;;多义线端点输出到文件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)
)
发表于 2018-1-3 16:22 | 显示全部楼层
不是csv么,excel打开了删掉不要的坐标就是了。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2018-4-27 00:51 , Processed in 0.264559 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表