cad引出线段lisp_AutoCAD表格导出(AutoLISP原程序)——好用的AutoCAD文本和线条表格导出工...

最新推荐文章于 2023-09-17 05:36:33 发布

weixin_39768917

最新推荐文章于 2023-09-17 05:36:33 发布

阅读量621

点赞数

文章标签： cad引出线段lisp

本文链接：https://blog.csdn.net/weixin_39768917/article/details/111765107

版权

这是一个使用AutoLISP编写的AutoCAD实用程序，用于将AutoCAD中的文本和线条表格导出为CSV文件。用户可以选择表格生长方向，并在选择字段后自动进行边界检测、填充和移动操作。程序还会提示用户指定保存的文件名，方便将数据导出到外部文件进行进一步处理。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

(defun c:bd( / oldcolor oldpltp dist pt e1 e2

n fil_w x str nf st l e m p1 p2 ttl tt ptx pty)

(setvar "modemacro" " YuCheng ")

(command "_.undo" "m")

(command)

(setvar "cmdecho" 0)

(setq n 0)

(setq oldcolor (getvar "cecolor"))

(setvar "CECOLOR" "red")

(setq oldpltp (getvar "PLINETYPE"))

(setvar "PLINETYPE" 1)

(setq e1 nil)

(setq ss (ssadd))

(setq sh (ssadd))

(setvar "osmode" 32)

(initget 0 "Up Down Left Right")

(setq fx (getkword "确定表格生长方向Up/Down/&ltDown&gt:"))

;(setq dist (getdist"\n&gt&gt**********&gt&gt输入行间距:"))

(setvar "osmode" 0)

(command)

(print '&gt&gt**********&gt&gt注意将打开的写入文件关闭，或更换文件名！！！)

(while (setq pt (getpoint"\n&gt&gt**********&gt&gt点击选择字段:"))

(command "_.boundary" "a" "i" "n" "" "" pt "")

(command)

(if (= (cdr (assoc 0 (entget (entlast)))) "LWPOLYLINE")

(setq e2 (entlast))

(setq e2 e1)

)

;(command "_.pedit" e2 "w" 1 "")

(command)

(if (/= e2 e1)

(progn

(setq ss (ssadd e2 ss))

(setq e1 e2)

(command "_.hatch" "s" e1 "")

(command)

(setq sh (ssadd (entlast) sh))

(redraw e2 2)

(setq n (+ n 1))

(print '&gt&gt*****&gt&gt已选字段数:)

(prin1 n)

)

(print '&gt&gt**********&gt&gt所选字段无效!!!)

)

(setq fil_w (getfiled "请指定保存的文件" "table" "csv" 1))

(setq x (open fil_w "w"))

(setq str "1")

(setq nf 0)

(while (/= str "")

(setq str "")

(setq st "")

(setq l 0)

(while (/= l n)

(if (setq e (ssname ss l))

(progn

(setq m 4)

(setq p1 (reverse (entget e)))

(while (&gt m 0)

(setq p1 (cdr p1))

(setq m (- m 1))

)

(setq p1 (cdar p1))

(setq m 12)

(setq p2 (reverse (entget e)))

(while (&gt m 0)

(setq p2 (cdr p2))

(setq m (- m 1))

)

(setq p2 (cdar p2))

(if (or (setq ttl (ssget "w" p1 p2 '((0 . "text")))) (setq ttl (ssget "w" p1 p2 '((0 . "mtext")))))

(progn

(setq tt (cdr (assoc 1 (entget (ssname ttl 0)))))

;(setq distx (abs (- (car p2) (car p1))))

(setq disty (abs (- (cadr p2) (cadr p1))))

)

(setq tt "")

)

(setq tt "")

)

(setq st (strcat st tt ","))

(setq str (strcat str tt))

(setq l (+ l 1))

)

(print)

(princ st)

(write-line st x)

(setq ptx (car p1))

(setq pty (cadr p1))

(cond

((= fx "Up") (setq pt (list ptx (+ pty disty) 0)))

((= fx "Down") (setq pt (list ptx (- pty disty) 0)))

((= fx nil) (setq pt (list ptx (- pty disty) 0)))

)

(setq nf (+ nf 1))

(command "_.move" ss sh "" p1 pt)

(command "_.pan" pt p1)

(command)