Lisp用于放置定义的excel

flausbert · 发表于 2022-7-6 08:05:55

大家好！

很长一段时间以来，我一直在这个论坛上受益于您对autocad lisps的丰富知识，但第一次我找不到我想要的东西，所以我发布了这个。如果你能帮我，我很感激。

多亏了你们，我正在使用张贴在这里的lisphttp://www.cadtutor.net/forum/showthread.php?31653-点到excel工作表的Lisp坐标-（点编号）

除了这个很棒的Lisp程序，我想知道你们是否可以安排一些事情，把标签放在这些点上，而不是只放数字。它完美地生成了数字，但我真正想要的是放置一个标签，我可以用连续的数字定义，比如WO 1，WO 2，WO 3。。。

如果你能帮我一把，我会非常高兴的

Lee Mac · 发表于 2022-7-6 08:14:23

下面是一个快速通用点标记程序：

copy

(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 (cons  7 (getvar 'TEXTSTYLE))
   )
   (initget "LtR RtL BtT TtB")
   (setq dr (cond ((getkword (strcat "\nSpecify Direction [LtR/RtL/BtT/TtB] <" (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 ) (< (cadr  a) (cadr  b))))
                               ("RtL" . (lambda ( a b ) (> (cadr  a) (cadr  b))))
                               ("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)
)

flausbert · 发表于 2022-7-6 08:25:43

给出了错误的论点。你能再查一下吗

marko_ribar · 发表于 2022-7-6 08:35:54

在这里，我纠正了。。。也许李在交通高峰期。。。

copy


(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 (cons  7 (getvar 'TEXTSTYLE))
   )
   (initget "LtR RtL BtT TtB")
   (setq dr (cond ((getkword (strcat "\nSpecify Direction [LtR/RtL/BtT/TtB] <" (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 ) (< (car  a) (car  b))))
                               ("RtL" . (lambda ( a b ) (> (car  a) (car  b))))
                               ("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。

Lee Mac · 发表于 2022-7-6 08:41:12

所有这些都对我有效，我的代码没有错误

flausbert · 发表于 2022-7-6 08:46:12

李和马尔科，谢谢你们。现在效果很好。既然我在这里看到了你们两个，你们认为可以修改它，使标签可以来自excel的一列，而点可以来自另一列？

我需要能够将带有这些标签的坐标导出到excel中，如下所示：http://www.cadtutor.net/forum/showthread.php?31653-点到excel工作表的Lisp坐标-（点编号）

flausbert · 发表于 2022-7-6 08:57:25

我简直不敢相信，我从早上开始提到的帖子已经做到了。我只是到最后才读。非常感谢VVA和李，我也看到了你们在那个帖子中的贡献。你们真是太棒了

marko_ribar · 发表于 2022-7-6 09:01:35

试试这个：

copy


(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 (cons  7 (getvar 'TEXTSTYLE))
   )
   (initget "LtR RtL BtT TtB")
   (setq dr (cond ((getkword (strcat "\nSpecify Direction [LtR/RtL/BtT/TtB] <" (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 ) (< (car  a) (car  b))))
                               ("RtL" . (lambda ( a b ) (> (car  a) (car  b))))
                               ("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。

flausbert · 发表于 2022-7-6 09:13:21

实际上，我在想，如果我们在excel表格中有两列，比如213123.2112314,54和另一个相邻的列作为对这一点的描述，比如第1点。我们可以把这个描述放在给定坐标的点上吗？

[编程交流] Lisp用于放置定义的excel

发表回复

精选推荐