求修改lisp程序，如何提取CAD图中多段线的坐标（要当前ucs坐标系）
发布网友
发布时间：2022-05-20 14:26
共2个回答
热心网友
时间：2023-10-28 19:34
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (setq wjm (getfiled "请指定要保存的坐标文件" "e:\\" "txt" 1))
(if (setq ssa (ssget '((0 . "LWPOLYLINE"))))
(progn
(setq fff (open wjm "w")
n (sslength ssa)
i 0
no 0
)
(repeat n
(setq dxf (entget (ssname ssa i))
i (1+ i)
ptb (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= (car x) 10)) dxf))
ptb (mapcar '(lambda(x)(trans x 0 1)) ptb)
)
(foreach pt ptb
(setq no (1+ no))
(write-line (strcat (itoa no) ","
(rtos (car pt) 2 2) ","
(rtos (cadr pt) 2 2) ","
)
fff
)
)
)
(close fff)
(princ (strcat "\n坐标已存入\"" wjm "\"中"))
)
)
)
(setvar "cmdecho" cm)
(princ)
)
热心网友
时间：2023-10-28 19:34
热心网友
时间：2023-10-28 19:34
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (setq wjm (getfiled "请指定要保存的坐标文件" "e:\\" "txt" 1))
(if (setq ssa (ssget '((0 . "LWPOLYLINE"))))
(progn
(setq fff (open wjm "w")
n (sslength ssa)
i 0
no 0
)
(repeat n
(setq dxf (entget (ssname ssa i))
i (1+ i)
ptb (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= (car x) 10)) dxf))
ptb (mapcar '(lambda(x)(trans x 0 1)) ptb)
)
(foreach pt ptb
(setq no (1+ no))
(write-line (strcat (itoa no) ","
(rtos (car pt) 2 2) ","
(rtos (cadr pt) 2 2) ","
)
fff
)
)
)
(close fff)
(princ (strcat "\n坐标已存入\"" wjm "\"中"))
)
)
)
(setvar "cmdecho" cm)
(princ)
)
热心网友
时间：2023-10-28 19:34
