用于将数据转换为ascii的Lisp例程
你好我试图在AutoCAD 2010中提取一些绘制线的数据。
需要的数据是它们的长度。有人可以编写lisp例程将其长度提取到ascii文件中吗？或者指出一个已经写好的。
list命令提供了太多提取的数据，每个屏幕只能列出一定数量的对象。
所需的结果ascii文件为；
长度
100.001
120.002
234.980
谢谢
附言
如果lisp例程可以从对象的数据中提取其他元素，例如它们的颜色，那就太好了。
是否可以使用可以保存到ascii文件的对象属性组合框为将来制作例程？ 我认为这可以做所有，但长度。。。
http://www.cadtutor.net/forum/showthread.php?t=42954 啊，我忘了我写了这个：
http://www.cadtutor.net/forum/showthread.php?t=42734 谢谢你的信息李。
我这里可能需要一个特别的。所示的lisp例程添加了层中线条的所有长度。我需要的是一个lisp，它将在ascii文件中列出行长度。例如
长度
23.45
45.67
67.89
原因是我需要为几何设计程序提取线的长度。
谢谢 试一试；
(defun c:GetLens (/ ss i ent e)
(vl-load-com)
(if (and (setq f (getfiled "Output" "" "txt" 9))
(setq i -1 ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))))
(progn
(setq f (open f "a"))
(while (setq ent (ssname ss (setq i (1+ i))))
(if (setq e (vlax-curve-getEndParam ent))
(write-line (rtos (vlax-curve-getDistatParam ent e)) f)))
(close f)))
(princ))
嗨，李，
这太棒了，完全正确。但是，我需要完成该项目，并将此lisp与另一个lisp相结合（如下所示）。
另一个是一个例程，从一条主线到第二条线绘制垂直线，其间留有空格。
看看你是否可以用你创建的lisp来改进我的lisp
非常感谢。
（定义c：测试(/
*错误*
项目名称1
项目名称2
末端分布
内部列表
指向
开始列表
步
坦彭特
VlaObj1
VlaObj2
)
（defun*错误*（msg）
（如果是TempEnt
（entdel TempEnt）
)
（普林斯）
)
（if（和（setq EntName1（car（entsel“\n选择主线：”））
（setq EntName2（car（entsel“\n选择辅助行：”））
（setq步骤（getdist“\n输入步骤：”）
（>步骤0.0）
)
（progn（setq VlaObj1（vlax ename->vla object EntName1）
VlaObj2（vlax ename->vla object EntName2）
StartDist 0.0
EndDist（vlax curve getDistAtParam VlaObj1（vlax curve getEndParam VlaObj1））
)
（虽然(
（设定点（vlax曲线getPointAtDist VlaObj1 StartDist））
（如果（不是）（vl-catch-all-error-p
（setq列表
（vl全包适用
'vlax safearray->列表
（列表（vlax变量值
（vla与相交
（vlax ename->vla对象
（setq TempEnt）
（entmakex）
（列表
（cons 0“线”）
（缺点10分）
（缺点
11
（极性
指向
（（（角度）
（vlax曲线getFirstDeriv
VlaObj1
（vlax曲线getParamAtDist
VlaObj1
开始列表
)
)
（列表0.0 0.0）
)
（/pi 2）
)
1
)
)
)
)
)
)
VlaObj2
A扩展此实体
)
)
)
)
)
)
)
（恩特梅克）
（列表（cons 0“行”）
（缺点10分）
（列表11（car IntersList）（cadr IntersList）（caddr IntersList））
)
)
)
（entdel TempEnt）
（setq StartDist（+StartDist Step））
)
)
)
（普林斯）
)
（普林斯）
(defun c:test(/ *error* DOC E1 E2 EDIS FILE ILST L LLST OBJ2 OFILE PA PT SDIS SPC TMP)
(vl-load-com)
;; Lee Mac~24.03.10
(defun *error*(msg)
(and tmp (entdel tmp))
(and ofile (close ofile))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(defun isCurveObj (x)
(not (vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-curve-getEndParam) (list x)))))
(defun line (p1 p2)
(entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))
(setq spc(if (or (eq AcModelSpace (vla-get-ActiveSpace
(setq doc (vla-get-ActiveDocument
(vlax-get-acad-object)))))
(eq :vlax-true (vla-get-MSpace doc)))
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)))
(or *step* (setq *step* 10.))
(if (apply (function and)
(append
(mapcar
(function (lambda (x s)
(while
(progn
(set x (car (entsel s)))
(cond ((eq 'ENAME (type (eval x)))
(if (not (isCurveObj (eval x)))
(princ "\n** Invalid Object Selected **")))))) x))
'(e1 e2) '("\nSelect PRIMARY line: " "\nSelect SECONDARY line: "))
(list (setq file (getfiled "Output File" "" "txt" 9)))))
(progn
(initget 6)
(setq *step* (cond ((getdist (strcat "\nSpecify Step <" (rtos *step*) "> : "))) (*step*))
sDis (- (vlax-curve-getDistatParam e1
(vlax-curve-getStartParam e1)) *step*)
eDis (vlax-curve-getDistatParam e1
(vlax-curve-getEndParam e1)))
(mapcar (function set) '(obj1 obj2)
(mapcar (function vlax-ename->vla-object) (list e1 e2)))
(while (<= (setq sDis (+ sDis *step*)) eDis)
(setq pa (vlax-curve-getParamatDist e1 sDis)
pt (vlax-curve-getPointatDist e1 sDis))
(if (progn
(setq iLst (vlax-invoke
(vlax-ename->vla-object
(setq tmp
(Line pt (polar pt (+ (angle '(0 0 0)
(vlax-curve-getFirstDeriv e1 pa)) (/ pi 2.)) 1.))))
'IntersectWith Obj2 acExtendThisEntity)) (entdel tmp)
iLst)
(setq lLst (cons (vlax-curve-getDistatParam
(setq l (Line pt (list (car iLst) (cadr iLst) (caddr iLst))))
(vlax-curve-getEndParam l)) lLst))))
(setq ofile (open file "a"))
(mapcar (function (lambda (x) (write-line (rtos x) ofile))) lLst)
(setq ofile (close ofile))))
(princ))
嗨，李，
这太棒了。我对这个版本很满意，但是当我把它展示给其他人时，他们质疑增量的数据输出。
理想情况下，我会为自己保留这个版本，因为我可以在心里计算出增值。对于它们，我们可以用增量将数据导出到ascii。例如
增量和长度
0;10.78
10; 21.56
20; 32.78
30; 89.97
e、 t.c
谢谢
尝试稍微编辑的代码
(defun c:test(/
*error*
EntName1
EntName2
EndDist
IntersList
Point
StartDist
Step
TempEnt
VlaObj1
VlaObj2
dist
filedesc
filename
out_list
strline
)
(defun *error*(msg)
(if TempEnt
(entdel TempEnt)
)
(princ)
)
(if (and (setq EntName1 (car (entsel "\nSelect primary line: ")))
(setq EntName2 (car (entsel "\nSelect secondary line: ")))
(setq Step (getdist "\nEnter step: "))
(> Step 0.0)
)
(progn (setq VlaObj1 (vlax-ename->vla-object EntName1)
VlaObj2 (vlax-ename->vla-object EntName2)
StartDist 0.0
EndDist (vlax-curve-getDistAtParam
VlaObj1
(vlax-curve-getEndParam VlaObj1))
)
(while (< StartDist EndDist)
(setq Point (vlax-curve-getPointAtDist VlaObj1 StartDist))
(if (not (vl-catch-all-error-p
(setq IntersList
(vl-catch-all-apply
'vlax-safearray->list
(list (vlax-variant-value
(vla-IntersectWith
(vlax-ename->vla-object
(setq TempEnt
(entmakex
(list
(cons 0 "LINE")
(cons 10 Point)
(cons
11
(polar
Point
(- (angle
(vlax-curve-getFirstDeriv
VlaObj1
(vlax-curve-getParamAtDist
VlaObj1
StartDist
)
)
(list 0.0 0.0)
)
(/ pi 2)
)
1.0
)
)
)
)
)
)
VlaObj2
acExtendThisEntity
)
)
)
)
)
)
)
(progn
(entmake
(list (cons 0 "LINE")
(cons 10 Point)
(list 11
(car IntersList)
(cadr IntersList)
(caddr IntersList))
)
)
(setq dist (distance Point
(list (car IntersList)
(cadr IntersList)
(caddr IntersList)))
)
(setq strline (strcat (rtos StartDist 2 0) ";" (rtos dist 2 2)))
(setq out_list (cons strline out_list))
)
)
(entdel TempEnt)
(setq StartDist (+ StartDist Step))
)
(if out_list
(if (setq filename (getfiled "Road sections file" "C:\\" "txt" 9))
(progn
(setq filedesc (open filename "a"))
(foreach line(reverse out_list)
(write-line line filedesc)
)
)
(close filedesc)
)
)
)
)
(princ)
)
(prompt "\nType TEST to execute")
(prin1)
~'J'~ 也许是这样：
(defun c:test(/ *error* DOC E1 E2 EDIS FILE ILST L LLST OBJ2 OFILE PA PT SDIS SPC TMP)
(vl-load-com)
;; Lee Mac~24.03.10
(defun *error*(msg)
(and tmp (entdel tmp))
(and ofile (close ofile))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(defun isCurveObj (x)
(not (vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-curve-getEndParam) (list x)))))
(defun line (p1 p2)
(entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))
(setq spc(if (or (eq AcModelSpace (vla-get-ActiveSpace
(setq doc (vla-get-ActiveDocument
(vlax-get-acad-object)))))
(eq :vlax-true (vla-get-MSpace doc)))
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)))
(or *step* (setq *step* 10.))
(if (apply (function and)
(append
(mapcar
(function (lambda (x s)
(while
(progn
(set x (car (entsel s)))
(cond ((eq 'ENAME (type (eval x)))
(if (not (isCurveObj (eval x)))
(princ "\n** Invalid Object Selected **")))))) x))
'(e1 e2) '("\nSelect PRIMARY line: " "\nSelect SECONDARY line: "))
(list (setq file (getfiled "Output File" "" "txt" 9)))))
(progn
(initget 6)
(setq *step* (cond ((getdist (strcat "\nSpecify Step <" (rtos *step*) "> : "))) (*step*))
sDis (- (vlax-curve-getDistatParam e1
(vlax-curve-getStartParam e1)) *step*)
eDis (vlax-curve-getDistatParam e1
(vlax-curve-getEndParam e1)))
(mapcar (function set) '(obj1 obj2)
(mapcar (function vlax-ename->vla-object) (list e1 e2)))
(while (<= (setq sDis (+ sDis *step*)) eDis)
(setq pa (vlax-curve-getParamatDist e1 sDis)
pt (vlax-curve-getPointatDist e1 sDis))
(if (progn
(setq iLst (vlax-invoke
(vlax-ename->vla-object
(setq tmp
(Line pt (polar pt (+ (angle '(0 0 0)
(vlax-curve-getFirstDeriv e1 pa)) (/ pi 2.)) 1.))))
'IntersectWith Obj2 acExtendThisEntity)) (entdel tmp)
iLst)
(setq lLst (cons (cons sDis (vlax-curve-getDistatParam
(setq l (Line pt (list (car iLst) (cadr iLst) (caddr iLst))))
(vlax-curve-getEndParam l))) lLst))))
(setq ofile (open file "a"))
(mapcar
(function
(lambda (x)
(write-line (strcat (rtos (car x)) ";" (rtos (cdr x))) ofile))) (reverse lLst))
(setq ofile (close ofile))))
(princ))
页:
[1]