Lisp用于放置定义的excel
大家好！很长一段时间以来，我一直在这个论坛上受益于您对autocad lisps的丰富知识，但第一次我找不到我想要的东西，所以我发布了这个。如果你能帮我，我很感激。
多亏了你们，我正在使用张贴在这里的lisphttp://www.cadtutor.net/forum/showthread.php?31653-点到excel工作表的Lisp坐标-（点编号）
除了这个很棒的Lisp程序，我想知道你们是否可以安排一些事情，把标签放在这些点上，而不是只放数字。它完美地生成了数字，但我真正想要的是放置一个标签，我可以用连续的数字定义，比如WO 1，WO 2，WO 3。。。
如果你能帮我一把，我会非常高兴的 下面是一个快速通用点标记程序：
(defun c:ptlabel ( / ht i l pr s sf ts )
(setq
pr (getstring t "\nSpecify Label Prefix <None>: ")
sf (getstring t "\nSpecify Label Suffix <None>: ")
st (cond ((getint (strcat "\nSpecify Start Number <" (itoa (setq st (cond (st) (1)))) ">: "))) (st))
ht (cons 40 (getvar 'TEXTSIZE))
ts (cons7 (getvar 'TEXTSTYLE))
)
(initget "LtR RtL BtT TtB")
(setq dr (cond ((getkword (strcat "\nSpecify Direction <" (setq dr (cond (dr) ("LtR"))) ">: "))) (dr)))
(if (setq s (ssget '((0 . "POINT"))))
(progn
(repeat (setq i (sslength s))
(setq l (cons (assoc 10 (entget (ssname s (setq i (1- i))))) l))
)
(foreach pt
(vl-sort l
(cdr
(assoc dr
'(
("LtR" . (lambda ( a b ) (< (cadra) (cadrb))))
("RtL" . (lambda ( a b ) (> (cadra) (cadrb))))
("BtT" . (lambda ( a b ) (< (caddr a) (caddr b))))
("TtB" . (lambda ( a b ) (> (caddr a) (caddr b))))
)
)
)
)
(entmake (list '(0 . "TEXT") pt ht ts '(72 . 1) '(73 . 2) (cons 11 (cdr pt)) (cons 1 (strcat pr (itoa st) sf))))
(setq st (1+ st))
)
)
)
(princ)
) 给出了错误的论点。你能再查一下吗 在这里，我纠正了。。。也许李在交通高峰期。。。
(defun c:ptlabel ( / dr ht i lst pr s st sf ts )
(setq
pr (getstring t "\nSpecify Label Prefix <None>: ")
sf (getstring t "\nSpecify Label Suffix <None>: ")
st (cond ((getint (strcat "\nSpecify Start Number <" (itoa (setq st (cond (st) (1)))) ">: "))) (st))
ht (cons 40 (getvar 'TEXTSIZE))
ts (cons7 (getvar 'TEXTSTYLE))
)
(initget "LtR RtL BtT TtB")
(setq dr (cond ((getkword (strcat "\nSpecify Direction <" (setq dr (cond (dr) ("LtR"))) ">: "))) (dr)))
(if (setq s (ssget '((0 . "POINT"))))
(progn
(repeat (setq i (sslength s))
(setq lst (cons (cdr (assoc 10 (entget (ssname s (setq i (1- i)))))) lst))
)
(foreach pt
(vl-sort lst
(cdr
(assoc dr
'(
("LtR" . (lambda ( a b ) (< (cara) (carb))))
("RtL" . (lambda ( a b ) (> (cara) (carb))))
("BtT" . (lambda ( a b ) (< (cadr a) (cadr b))))
("TtB" . (lambda ( a b ) (> (cadr a) (cadr b))))
)
)
)
)
(entmake (list '(0 . "TEXT") (cons 10 pt) ht ts '(72 . 1) '(73 . 2) (cons 11 pt) (cons 1 (strcat pr (itoa st) sf))))
(setq st (1+ st))
)
)
)
(princ)
)
李，希望你生气。。。干杯，周末快乐。。。M、 R。
所有这些都对我有效，我的代码没有错误 李和马尔科，谢谢你们。现在效果很好。既然我在这里看到了你们两个，你们认为可以修改它，使标签可以来自excel的一列，而点可以来自另一列？
我需要能够将带有这些标签的坐标导出到excel中，如下所示：http://www.cadtutor.net/forum/showthread.php?31653-点到excel工作表的Lisp坐标-（点编号） 我简直不敢相信，我从早上开始提到的帖子已经做到了。我只是到最后才读。非常感谢VVA和李，我也看到了你们在那个帖子中的贡献。你们真是太棒了 试试这个：
(defun c:ptlabel ( / dr fn file ht i lst pr s st sf ts )
(setq
pr (getstring t "\nSpecify Label Prefix <None>: ")
sf (getstring t "\nSpecify Label Suffix <None>: ")
st (cond ((getint (strcat "\nSpecify Start Number <" (itoa (setq st (cond (st) (1)))) ">: "))) (st))
ht (cons 40 (getvar 'TEXTSIZE))
ts (cons7 (getvar 'TEXTSTYLE))
)
(initget "LtR RtL BtT TtB")
(setq dr (cond ((getkword (strcat "\nSpecify Direction <" (setq dr (cond (dr) ("LtR"))) ">: "))) (dr)))
(if (setq s (ssget '((0 . "POINT"))))
(progn
(setq fn (getfiled "Enter file to save to" (getvar 'dwgprefix) "csv" 1))
(setq file (open fn "w"))
(repeat (setq i (sslength s))
(setq lst (cons (cdr (assoc 10 (entget (ssname s (setq i (1- i)))))) lst))
)
(foreach pt
(vl-sort lst
(cdr
(assoc dr
'(
("LtR" . (lambda ( a b ) (< (cara) (carb))))
("RtL" . (lambda ( a b ) (> (cara) (carb))))
("BtT" . (lambda ( a b ) (< (cadr a) (cadr b))))
("TtB" . (lambda ( a b ) (> (cadr a) (cadr b))))
)
)
)
)
(entmake (list '(0 . "TEXT") (cons 10 pt) ht ts '(72 . 1) '(73 . 2) (cons 11 pt) (cons 1 (strcat pr (itoa st) sf))))
(write-line (strcat pr (itoa st) sf "," (vl-princ-to-string pt)) file)
(setq st (1+ st))
)
(close file)
(startapp "explorer.exe" fn)
)
)
(princ)
)
如果我理解正确，您希望将点数据从CAD导出到EXCEL。。。选项是通过CSV文件；启动EXCEL后，您可以将工作表数据保存为任何EXCEL文件格式，如XLS等。。。
干杯，M.R。 实际上，我在想，如果我们在excel表格中有两列，比如213123.2112314,54和另一个相邻的列作为对这一点的描述，比如第1点。我们可以把这个描述放在给定坐标的点上吗？
页:
[1]