从文件坐标绘制多段线
你能帮助我吗？？。谢谢文件excel。拉链 我不久前写的这个-将从txt文件中提取。假设点以逗号分隔。
(defun c:ptpoly (/ doc spc file nl ptlst)
(vl-load-com)
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(if (setq file (getfiled "Select File" "" "txt" )
(progn
(setq file (open file "r"))
(while (setq nl (read-line file))
(setq ptlst (cons (StrBrk nl 44) ptlst)))
(close file)
(if ptlst
(progn
(setq ptlst
(apply 'append
(mapcar
(function
(lambda (x)
(list (car x) (cadr x))))
(reverse
(mapcar
(function
(lambda (x)
(mapcar 'distof x))) ptlst)))))
(vla-addLightweightpolyline spc
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbdouble
(cons 0 (1- (length ptlst)))) ptlst))))
(princ "\n<< No Points Found in File >>")))
(princ "\n<< No File Selected >>"))
(princ))
(defun StrBrk (str chrc / pos lst)
(while (setq pos (vl-string-position chrc str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos 2))))
(reverse (cons str lst)))
我有一个Excel文件可以做你想要的，但不能上传。我不知道为什么
请给我发一封电子邮件
hasancad@gmail.com 我认为你需要压缩Excel文件，因为它们不是受支持的文件上传类型。 我在2个文件（作为论坛容量）中作为RAR压缩，但无法上传
如果你愿意，我会发电子邮件给你， 不要使用RAR压缩，因为这不是一种常见的（免费）可用格式。尝试将Excel文件保存为CSV文件，并将大约十行内容复制到帖子中。
试试这个，只需选择只有数字的双巴松
在2008年、Excel 2003上测试
(vl-load-com)
(defun C:PX (/ acapp acsp adoc aexc cel col cols coords csht
item nwb points poly rang result row rows sht tmp wbks)
(setq aexc (vlax-get-or-create-object "Excel.Application")
wbks (vlax-get-property aexc "Workbooks")
nwb(vlax-invoke-method wbks "Open" "C:\\File excel.xls");;<--change file name here
sht(vlax-get-property nwb "Sheets")
csht (vlax-get-property sht "Item" 1)
)
(vla-put-visible aexc :vlax-true)
(setq rang (vlax-invoke-method
(vlax-get-property aexc "Application")
"InputBox"
"Select Diapazone To Get Coordinates"
"Let you get a points"
nil
nil
nil
nil
nil
(vlax-make-variant 8 3))
)
(setq rang (vlax-variant-value rang)
)
(setq coords (vlax-get-property rang "Value2")
)
(setq rows (vlax-get-property (vlax-get-property rang "Rows") "Count")
)
(setq cols (vlax-get-property
(vlax-get-property rang "Columns")
"Count")
)
(setq row 1)
(repeat rows
(setq col 1)
(repeat cols
(setq cel (vlax-variant-value
(vlax-get-property
(vlax-get-property rang "Cells")
"Item"
(vlax-make-variant row vlax-vbLong)
(vlax-make-variant col vlax-vbLong))))
(setq item (vlax-variant-value
(vlax-get-property cel "Value2"))
)
(setq tmp (cons item tmp)
)
(setq col (1+ col)
)
)
(setq points (cons (reverse tmp) points)
tmp nil
row (1+ row)
)
)
(setq points (reverse points)
points (apply 'append points)
)
(vl-catch-all-apply
(function (lambda ()
(vlax-invoke-method
nwb
"Close" :vlax-false)))
)
(vl-catch-all-apply
(function (lambda ()
(vlax-invoke-method
aexc
"Quit")))
)
(mapcar (function (lambda (x)
(vl-catch-all-apply
(function (lambda ()
(progn
(vlax-release-object x)
(setq x nil)))))))
(list rang csht nwb wbks aexc)
)
(setq
adoc (vla-get-activedocument
(setq acapp (vlax-get-acad-object))
)
)
(if (= 1 (vlax-get-property adoc "Activespace"))
(setq acsp (vla-get-modelspace adoc))
(setq acsp (vla-get-paperspace adoc))
)
(setq poly (vlax-invoke acsp "Add3DPoly" points)
)
(vla-eval
acapp
(strcat
"ThisDrawing.SetVariable \"USERI1\","
"MsgBox (\"Close Polyline?\","
"vbYesNo"
",\""
"Answer this question:"
"\")"
)
)
(if (= 6 (setq result (getvar "USERI1")))
(vlax-put-property poly "Closed" :vlax-true)
)
(vla-zoomextents acapp)
(gc)
(gc)
(princ)
)
(prompt "\t\t***\t\nType PX to run program\t***")
(prin1)
我下载了文件，并以csv格式保存，删除了一些列和一行，然后再次以csv格式保存，结果如下：-
0,0,0
0.05,0.002,0.05
0.1,0.01,0.1
0.148,0.022,0.15
0.196,0.04,0.2
0.242,0.062,0.25
0.287,0.089,0.3
0.329,0.12,0.35
0.368,0.156,0.4
然后我打开文本文件，选择全部并复制，转到AutoCAD，启动“三维多段线”命令，当它需要起点时，我单击命令行并粘贴，下面是我得到的结果（不使用Lisp）。
谢谢你的花（李）
我刚刚从Excel VBA帮助中获取了所有这些内容
部分来自我以前的经历
当做
奥列格
~'J'~ 埃尔登
在Excel文件中填写点坐标，然后选择输入点旁边的黄色单元格，然后复制（Ctrl+C）选定区域，然后粘贴到AutoCAD命令行中。
页:
[1]
2