Question

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

list 输出的东西太多了，我只要三维坐标，求大虾们帮帮忙！！！

Answer 1

复制下面的脚本到命令行回车即可加载，输入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，有误！