求CAD lisp 程序,选择一条或多条多段线,输出其上点的x,y,z坐标.

求CAD lisp 程序,选择一条或多条多段线,输出其上点的x,y,z坐标.
list 输出的东西太多了,我只要三维坐标,求大虾们帮帮忙!

复制下面的脚本到命令行回车即可加载,输入pldd,程序会提示选择pline,选择pline后会打印所有的三维坐标
(defun c:pldd (/ wb cc ss1 aa pts bhbz ent)
(setq ent (car (entsel "\n请选择PLINE")))
(setq wb (entget ent) cc nil bhbz (cdr (assoc 70 wb)) )
(cond
((= (cdr (assoc 0 wb)) "POLYLINE")
(setq ss1 (entnext ent))
(while (/= ss1 nil)
(setq aa (entget ss1))
(if (= (cdr (assoc 0 aa)) "VERTEX") (progn
(setq aa (cdr (assoc 10 aa)))
(if (/= aa nil) (progn
(if (= (length aa) 2)
(setq aa (list (car aa) (cadr aa) 0.0) )
)
(if (= cc nil)
(setq pts aa)
)
(setq cc (cons aa cc))
))
(setq ss1 (entnext ss1))
)
(setq ss1 nil)
)
)
(if (= bhbz 1)
(setq cc (cons pts cc))
)
)
((= (cdr (assoc 0 wb)) "LWPOLYLINE")
(setq wb (member (assoc 10 wb) wb))
(while (assoc 10 wb)
(setq aa (cdr (assoc 10 wb)))
(if (= (length aa) 2)
(setq aa (list (car aa) (cadr aa) 0.0) )
)
(if (= cc nil)
(setq pts aa)
)
(if (= (length aa) 2)
(setq aa (list (car aa) (cadr aa) 0.0) )
)
(setq cc (cons aa cc) wb (cdr wb))
(if (assoc 10 wb)
(setq wb (member (assoc 10 wb) wb))
)
)
(if (= bhbz 1)
(setq cc (cons pts cc))
)
)
((= (cdr (assoc 0 wb)) "SPLINE")
(setq wb (member (assoc 11 wb) wb))
(while (assoc 11 wb)
(setq aa (cdr (assoc 11 wb)))
(if (= (length aa) 2)
(setq aa (list (car aa) (cadr aa) 0.0) )
)
(if (= cc nil)
(setq pts aa)
)
(setq cc (cons aa cc) wb (cdr wb))
(if (assoc 11 wb)
(setq wb (member (assoc 11 wb) wb))
)
)
)
)
cc
) ;end of defun
再问： 先谢谢啦！能否再修改一下？ 1、输出方式改为 X=***** Y=***** Z=*****换行（最好能自动新建一个文本文档）。 2、精度：保留4位小数。 3、不要科学计数法输出。 ((411717.0 4.92066e+006 0.0) (411732.0 4.92062e+006 0.0)) 这时你给出的输出！
再答： (defun c:pldd (/ wb cc ss1 aa pts bhbz ent fpt pt) (setq ent (car (entsel "\n请选择PLINE"))) (setq wb (entget ent) cc nil bhbz (cdr (assoc 70 wb)) ) (cond ((= (cdr (assoc 0 wb)) "POLYLINE") (setq ss1 (entnext ent)) (while (/= ss1 nil) (setq aa (entget ss1)) (if (= (cdr (assoc 0 aa)) "VERTEX") (progn (setq aa (cdr (assoc 10 aa))) (if (/= aa nil) (progn (if (= (length aa) 2) (setq aa (list (car aa) (cadr aa) 0.0) ) ) (if (= cc nil) (setq pts aa) ) (setq cc (cons aa cc)) )) (setq ss1 (entnext ss1)) ) (setq ss1 nil) ) ) (if (= bhbz 1) (setq cc (cons pts cc)) ) ) ((= (cdr (assoc 0 wb)) "LWPOLYLINE") (setq wb (member (assoc 10 wb) wb)) (while (assoc 10 wb) (setq aa (cdr (assoc 10 wb))) (if (= (length aa) 2) (setq aa (list (car aa) (cadr aa) 0.0) ) ) (if (= cc nil) (setq pts aa) ) (if (= (length aa) 2) (setq aa (list (car aa) (cadr aa) 0.0) ) ) (setq cc (cons aa cc) wb (cdr wb)) (if (assoc 10 wb) (setq wb (member (assoc 10 wb) wb)) ) ) (if (= bhbz 1) (setq cc (cons pts cc)) ) ) ((= (cdr (assoc 0 wb)) "SPLINE") (setq wb (member (assoc 11 wb) wb)) (while (assoc 11 wb) (setq aa (cdr (assoc 11 wb))) (if (= (length aa) 2) (setq aa (list (car aa) (cadr aa) 0.0) ) ) (if (= cc nil) (setq pts aa) ) (setq cc (cons aa cc) wb (cdr wb)) (if (assoc 11 wb) (setq wb (member (assoc 11 wb) wb)) ) ) ) ) (if cc (progn (setq fpt (open "c:/pt.txt" "w")) (foreach pt cc (princ (strcat (strcat "X=" (rtos (car pt) 2 4)) (strcat " Y=" (rtos (cadr pt) 2 4)) (strcat " Z=" (rtos (caddr pt) 2 4)) "\n" ) fpt ) ) (close fpt) (princ "\n已经写入c:/pt.txt") ) ) (princ) ) ;end of defun
再问： 还有个小问题 "LWPOLYLINE“ 的输出，Z坐标都为0，有误！
再答： 恩，可能是你的权限太低了，不能在C:\写东西。我这里试了没问题才给你发的 命令: pldd 请选择PLINE 已经写入c:/pt.txt ---------------------------------------------- X=10681 Y=437.6023 Z=0 X=9899.8168 Y=2017.9229 Z=0 X=7576.2975 Y=2197.9594 Z=0 X=6674.9322 Y=-662.6209 Z=0 X=3620.3056 Y=1117.7403 Z=0 X=1527.1352 Y=187.5516 Z=0 你可以把 (setq fpt (open "c:/pt.txt" "w")) 这句里的路径改改，比如d:/pt.txt