品茗新秀 发表于 2014-3-22 20:46:14

求在图中指定地方生成已有图层的图层名文字，且图层名即在对应的图层，文字上下顺...

本帖最后由 品茗新秀 于 2014-3-23 20:27 编辑

求在图中指定地方生成已有图层的图层名文字，且图层名即在对应的图层，

SunSpring 发表于 2014-3-22 20:46:15

品茗新秀 发表于 2014-3-23 18:54 static/image/common/back.gif
图层生成是这个样子，如果能排序就好了，如图圈圈的应在最后

(defun c:lsa ( / layerdata layerlst layername pt textsize)
(defun maketext (locationpoint textheight text rowtype)
    (entmake (list '(0 . "TEXT")
                   '(100 . "AcDbText")
                  (cons 40 textheight)
                   '(41 . 0.8)
                  (cons 1 text)
                  (cons 72 rowtype)
                   '(10 0.0 0.0 0.0)
                  (cons 11 (trans locationpoint 1 0))
                   '(73 . 2)
             )
    )
)
(setq textsize (* (getvar "dimscale") (getvar "textsize")))
(while (setq layerdata (tblnext "layer" (null layerdata)))
    (setq layername (cdr (assoc 2 layerdata)))
    (setq layerlst (cons layername layerlst))
)
(if (setq pt (getpoint "\n 指定插入点:"))
    (foreach layername (acad_strlsort layerlst)
      (setvar "clayer" layername)
      (maketext pt textsize layername 0)
      (setq pt (list (car pt) (- (cadr pt) (* 2 textsize))))
    )
)
(princ)
)

这下应该可以了.

llsheng_73 发表于 2014-3-22 22:19:41

做类似的图例用？

品茗新秀 发表于 2014-3-23 16:15:39

这个看样子难度较大，顶出高手

lpl 发表于 2014-3-23 16:36:09

我觉得院长应该出手了？？

SunSpring 发表于 2014-3-23 16:46:40

(defun c:lsa ( / layerdata layername pt textsize)
(defun maketext (locationpoint textheight text rowtype)
    (entmake (list '(0 . "TEXT")
                   '(100 . "AcDbText")
                  (cons 40 textheight)
                   '(41 . 0.8)
                  (cons 1 text)
                  (cons 72 rowtype)
                   '(10 0.0 0.0 0.0)
                  (cons 11 (trans locationpoint 1 0))
                   '(73 . 2)
             )
    )
)
(setq textsize (* (getvar "dimscale") (getvar "textsize")))
(if (setq pt (getpoint "\n 指定插入点:"))
    (while (setq layerdata (tblnext "layer" (null layerdata)))
      (setq layername (cdr (assoc 2 layerdata)))
      (setvar "clayer" layername)
      (maketext pt textsize layername 0)
      (setq pt (list (car pt) (- (cadr pt) (* 2 textsize))))
    )
)
(princ)
)
不知道是不是这样的效果,试下.

品茗新秀 发表于 2014-3-23 18:54:15

本帖最后由 品茗新秀 于 2014-3-23 18:55 编辑

SunSpring 发表于 2014-3-23 16:46 static/image/common/back.gif
不知道是不是这样的效果,试下.
图层生成是这个样子，如果能排序就好了，如图圈圈的应在最后


q3_2006 发表于 2014-3-24 15:19:53

品茗新秀 发表于 2014-3-23 18:54 static/image/common/back.gif
图层生成是这个样子，如果能排序就好了，如图圈圈的应在最后

加一句就行...
(defun c:lsa ( / layerdata layerlst layername pt textsize)
(defun maketext (locationpoint textheight text rowtype)
    (entmake (list '(0 . "TEXT")
                   '(100 . "AcDbText")
                  (cons 40 textheight)
                   '(41 . 0.8)
                  (cons 1 text)
                  (cons 72 rowtype)
                   '(10 0.0 0.0 0.0)
                  (cons 11 (trans locationpoint 1 0))
                   '(73 . 2)
             )
    )
)
(setq textsize (* (getvar "dimscale") (getvar "textsize")))
(while (setq layerdata (tblnext "layer" (null layerdata)))
    (setq layername (cdr (assoc 2 layerdata)))
    (setq layerlst (cons layername layerlst))
)
(setq layerlst (vl-sort layerlst '<))
(if (setq pt (getpoint "\n 指定插入点:"))
    (foreach layername (acad_strlsort layerlst)
      (setvar "clayer" layername)
      (maketext pt textsize layername 0)
      (setq pt (list (car pt) (- (cadr pt) (* 2 textsize))))
    )
)
(princ)
)
页: [1]
查看完整版本: 求在图中指定地方生成已有图层的图层名文字，且图层名即在对应的图层，文字上下顺...