多段线lisp布线的点
我想知道是否有人是新手或有一个计算多段线点数（垂直）的例程，加上x，y，z坐标并将其保存为。txt文件或excel之类的？？
任何帮助都将不胜感激。
艾米丽 试试这个。。。完成后，文件名将打印到命令行：
(defun c:pts2file (/ pts e file openf)
(vl-load-com)
(if (and (setq e (car (entsel)))
(= (cdr (assoc 0 (entget e))) "LWPOLYLINE")
(setq pts (mapcar 'cdr
(vl-remove-if-not
(function (lambda (pt) (= (car pt) 10)))
(entget e)
)
)
)
(setq file (strcat (getvar 'dwgprefix)
(getvar 'dwgname)
"__points.txt"
)
)
(setq openf (open file "w"))
)
(progn
(foreach pt pts
(write-line (vl-prin1-to-string pt) openf)
)
(close openf)
)
)
(princ file)
(princ)
)
下面是一个旧例程，用于提取PLINE路径点和包含的弧段：
;;;Returns ECS Point Values Of PLINE
(defun findpath (en / pl ed sp_flg cl_flg bf nl i vp bf vf pl_flg)
(and (/= (type en) 'ENAME)
(princ "\n*** FindPath Error *** ")
(exit))
(if (= "LWPOLYLINE" (cdr (assoc 0 (entget en))))
(command "_.CONVERTPOLY" "_Heavy" en ""))
(setq ed (entget en))
(and (/= "POLYLINE" (cdr (assoc 0 ed)))
(princ "\n*** POLYLINEs Only *** ")
(exit))
(setq pl_flg (cdr (assoc 70 ed)))
(and (= (logand pl_flg 1) 1)
(setq cl_flg T))
(and (= (logand pl_flg 4) 4)
(setq sp_flg T))
(and (or (= (logand pl_flg 16) 16)
(= (logand pl_flg 64) 64))
(princ "\nInvalid POLYLINE Mesh")
(exit))
(while (/= "SEQEND" (cdr (assoc 0 (entget (entnext en)))))
(setq en (entnext en)
ed (entget en)
vp (cdr (assoc 10 ed))
bf (cdr (assoc 42 ed))
vf (cdr (assoc 70 ed)))
(cond; ((= "SEQEND" (cdr (assoc 0 (entget (entnext en)))))
;(setq pl (cons vp pl)))
((and (/= bf 0.0)
(/= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
(add_arc vp (cdr (assoc 10 (entget (entnext en)))) bf))
((and (/= bf 0.0)
cl_flg
(= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
(add_arc vp (last pl) bf))
((and (= bf 1.0)
(not cl_flg)
(= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
(princ))
((and sp_flg
(= bf 0.0)
(= (logand vf8))
(setq pl (cons vp pl)))
((and (not sp_flg)
(= bf 0.0)
(/= (logand vf8))
(setq pl (cons vp pl)))))
(if (and cl_flg
(not (equal (car pl) (last pl))))
(setq pl (cons (last pl) pl)))
(setq i 0)
(while (< i (length pl))
(while (equal (nth i pl) (nth (1+ i) pl) 0.0001)
(setq i (1+ i)))
(and (nth i pl)
(setq nl (cons (nth i pl) nl)))
(setq i (1+ i)))
nl)
(defun add_arc (sp ep bulge / alist x1 x2 y1 y2 cotbce
ce ra sa ea ia inc qty na temp)
(setq x1 (car sp);;Modified Bulge
x2 (car ep);;Conversion By
y1 (cadr sp);;Duff Kurland
y2 (cadr ep);;Autodesk, Inc.
cotbce (/ (- (/ 1.0 bulge) bulge) 2.0)
ce (list (/ (+ x1 x2 (- (* (- y2 y1) cotbce))) 2.0)
(/ (+ y1 y2 (* (- x2 x1) cotbce) ) 2.0)
(caddr sp))
ra (distance ce sp)
sa (atan (- y1 (cadr ce)) (- x1 (car ce)))
ea (atan (- y2 (cadr ce)) (- x2 (car ce))))
(if (minusp sa)
(setq sa (+ sa (* 2.0 pi))))
(if (minusp ea)
(setq ea (+ ea (* 2.0 pi))))
(if (minusp bulge)
(setq temp sa sa ea ea temp))
(if (> sa ea)
(setq ia (+ (- (* pi 2.0) sa) ea))
(setq ia (- ea sa)))
(setq qty (abs (fix (/ ia (/ pi 16)))))
(if (< qty 2)
(setq qty 2))
(setq na sa
inc (/ (abs ia) qty))
(repeat (1+ qty)
(setq alist (cons (polar ce na ra) alist)
na (+ sa inc)
sa na))
(if (not (equal sp (car alist) 0.0001))
(setq alist (reverse alist)))
(foreach a alist
(setq pl (cons a pl))))
然后，您可以将列表pl导出到ascii文件-David 这将是一个导出类型的例程-大卫
(defun c:fpth (/ s ss ppl fn wf)
(while (or (not ss)
(> (sslength ss) 1))
(princ "\nSelect 1 PLINE")
(setq ss (ssget '((0 . "*POLYLINE")))))
(setq s (ssname ss 0))
(setq ppl (findpath s))
(while (or (not fn)
(not (snvalid fn)))
(setq fn (getstring "\nOutput File Name: ")))
(setq wf (open (strcat fn ".DAT") "w"))
(write-line "(setq path_list '(" wf)
(foreach p ppl
(write-line
(strcat "(" (rtos (car p) 2 12) " "
(rtos (cadr p) 2 12) " "
(rtos (caddr p) 2 12) ")") wf))
(write-line "))" wf)
(close wf)
(prin1))
另一个：
4
键入要调用的vWrite 杰出的
非常感谢大家的帮助，
艾米丽：D 大家好！！
我刚在谷歌上找到这篇文章，所以这是我在这里的第一篇文章。我不知道你们以前有没有为此烦恼过，但希望有人能帮上忙。
如何生成生成所有选定三维多段线顶点的lisp？
李，
对于CAD2002，例程不适用于多段线，仅适用于LWDOLYLINE。 现在这里有一个变体。。。这将首先要求您提供点编号系列，即101102103，用于描述“TBM”，然后是文件名
我写这篇文章的时候，我必须导出一个逗号圈定的全站仪点文件。。。
试试看。。。这是如果你想选择点（但实际上你不需要用上面的代码c“）
（defun c:wc（/cdwg cms cutl pt\u nm pt\u ds pt\u fn fso file ptw pn vl wtxt ptwo）（vl load com）（setq cdwg（vla get activedocument（vlax get acad object））cms（vla get modelspace cdwg）cutl（vla get utility cdwg））（setq pt\u nm（vla getinteger cutl“\n输入点号：”）pt\u ds（strcase（vla GetString cutl 1”\n输入描述号：“））pt\u fn（strcat（vla get path cdwg）“\”（vla GetString cutl 1“\n输入文件名：“）”.txt“）fso（vlax create object“Scripting.FileSystemObject”）文件（vlax invoke方法fso’CreateTextFile pt\u fn 8:vlax true））（而不是（vl-catch-all-error-p（vl catch all apply）（函数（lambda（）（setq ptw（vla getpoint cutl ptwo“\n点击坐标点：”）））（setq pn vl（vlax safearray->list（vlax variant value ptw））wtxt（strcat（itoa pt\u nm）”，“pt\u ds”，“（rtos（car pn vl）2 3）”，“（rtos（cadr pn vl）2 3）”，“（rtos（caddr pn vl）2 3））（vlax invoke file'Writeline wtxt）（setq pt\u nm（1+pt\u nm）ptwo ptw ptw nil））；while（vlax release object fso）（vlax invoke file'close））（提示“\n>>>…点文件导出已加载。键入WC以运行。。。
也许是这个？
http://lee-mac.com/ptmanager.html
页:
[1]
2