[求助]获取文件所有图层名，并把图层名写在对应的层上

my_autocad

获取文件所有图层名，并把图层名写在对应的层上

CAD的扩展工具中合并图层，挺好用的，我合并图层时，都是在不要的层上新建一个图元，再使用合并图层命令，挺麻烦的，所以建议，把获取文件所有图层名，并把图层名写在对应的层上，一看层名，就知道这个图层需要不需要，应该合并不合并了，一目了然，请高手帮帮忙。

yoyoho

;;;排序和CAD显示的顺序一样！

(defun TABLE (S / D R)
  (while (setq D (tblnext S (null D)))
    (setq R (cons (cdr (assoc 2 D)) R))
  )
)
(defun C:TT (/ LST N PT)
  (setq LST (acad_strlsort (TABLE "LAYER")))        ;;;CAD显示的顺序
  (setq PT (getpoint "文字插入点: ")
        N 0
  )
  (foreach NAME LST
    (entmake (list '(0 . "TEXT") (cons 8 NAME) '(100 . "AcDbText") (cons 10
                                                                         (list
                                                                               (car PT)
                                                                               (-
                                                                                  (cadr PT) N
                                                                               )
                                                                         )
                                                                   ) '
                   (40 . 6) (cons 1 NAME)
             )
    )
    (setq N (+ N 10.0))
  )
  (princ)
)

alexmai

flowerson 发表于 2008-6-7 16:53
程序很好。倒叙一下和显示的顺序一样！(defun TABLE (S / D R)  (while (setq D (tblnext S (null D)) ...

可否修改一下，这些文字都自动跟随自己所在的图层？

ljpnb

不错的，学习一下

龙龙仔

(defun TABLE (S / D R)
  (while (setq D (tblnext S (null D)))
    (setq R (cons (cdr (assoc 2 D)) R))
  )
)
(defun C:TT (/ LST N PT)
  (setq LST (TABLE "LAYER"))
  (setq T (getpoint "文字插入點: ")
 N  0
  )
  (foreach NAME LST
    (entmake (list
        '(0 . "TEXT")
        (cons 8 NAME)
        '(100 . "AcDbText")
        (cons 10 (list (car PT) (- (cadr PT) N)))
        '(40 . 6)
        (cons 1 NAME)
      )
    )
    (setq N (+ N 10.0))
  )
  (princ)
)

my_autocad

恩，程序相当好，现在配合CAD的扩展工具中的合并图层来，是相当顺手。

但生成的文字在世界坐标系中与用户坐标系中显示不同，但条件仍然满足。非常感谢

flowerson

程序很好。倒叙一下和显示的顺序一样！

(defun TABLE (S / D R)
  (while (setq D (tblnext S (null D)))
    (setq R (cons (cdr (assoc 2 D)) R))
  )
)
(defun C:TT (/ LST N PT)
  (setq LST (reverse (TABLE "LAYER")))
  (setq PT (getpoint "文字插入點: ")
        N 0
  )
  (foreach NAME LST
    (entmake (list '(0 . "TEXT") (cons 8 NAME) '(100 . "AcDbText") (cons 10
                                                                         (list
                                                                               (car PT)
                                                                               (-
                                                                                  (cadr PT) N
                                                                               )
                                                                         )
                                                                   ) '
                   (40 . 6) (cons 1 NAME)
             )
    )
    (setq N (+ N 10.0))
  )
  (princ)
)

llc1968

好用的很，下来研究研究，谢谢

xing979020

没什么意义。不明白

669423907

龙龙仔 发表于 2007-9-29 16:48
(defun TABLE (S / D R)  (while (setq D (tblnext S (null D)))    (setq R (cons (c ...

请问Z版，方便改成用鼠标点取两点来确定字高吗？
有时候那字体都小得看不见了。非常感谢！

669423907

用最笨的办法了.....
;列出所有图层名（龙龙仔 2007-9-29 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=63268）
(defun c:tcmm(/ LST N PT)
(command "undo" "be")
(defun TABLE (S / D R)
(while (setq D (tblnext S (null D)))
(setq R (cons (cdr (assoc 2 D)) R))))
(setq LST (reverse (TABLE "LAYER")))
(setq PT (getpoint "请指定文字插入點:") N 0)
(foreach NAME LST (entmake (list '(0 . "TEXT") (cons 8 NAME) '(100 . "AcDbText")
(cons 10 (list (car PT) (- (cadr PT) N))) ' (40 . 6) (cons 1 NAME)))
(setq N (+ N 10.0)))

(command "zoom" "O" (entlast) "")
(command "undo" "e")
(princ))

大师们方便给个更好的办法吗？

yaokui25

669423907 发表于 2013-5-19 20:39
用最笨的办法了.....
;列出所有图层名（龙龙仔 2007-9-29 http://bbs.mjtd.com/forum.php?mod=viewthread& ...

谢谢楼主代码，解决大问题了
嘿嘿~
不过为什么写出来的顺序跟现在的图层顺序不一致呢？
这点楼主有没有什么办法解决一下

lxy_2080

不错，留个脚印！！