Question

求修改lisp程序，如何提取CAD图中多段线的坐标（要当前ucs坐标系）

我的cad图是在当前坐标系里画的，list显示的也是当前坐标系坐标，但我找到以下程序提取出的是世界坐标系的坐标，求高手修改或给出新的程序并作出程序各代码的详细解释，我是lisp菜鸟。
源程序：
(defun c:zbc (/)
(setvar "cmdecho" 0)
(setq ffn (getfiled "\n保存的坐标文件" "写出的坐标" "txt" 1)
ff (open ffn "w")
ss (ssget '((0 . "*LINE")))
i -1)
(repeat (sslength ss)
(setq ssdata (entget (ssname ss (setq i (1+ i))))
n 0 )
(repeat (length ssdata)
(setq pp (nth n ssdata)
key (car pp) )
(if (= key 10)
(progn
(setq tx
(strcat (rtos (cadr pp) 2 2) " ," (rtos (caddr pp) 2 2)))
(write-line tx ff)) )
(setq n (1+ n)) ))
(close ff)
(princ (strcat "\n 坐标写至=>" ffn))
(princ)
)

Answer 1

(defun c:tqzb (/)
(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)
)

追问

我想要输出的格式为“123.12,145.23”这样，即不要前面的序号以及最后的逗号，望高手改下你的程序，

追答

(defun c:tqzb (/)
(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)
)

追问

老大，还不行啊，麻烦你再看看，我对照了一下程序，貌似没什么变化啊

追答

给你这个：

 

 

(defun c:tqzb (/)
    (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)
)

Answer 2

源程序呢？