求快速建立图层

chenbing111

求快速建立图层，要求是根据CAD图中出现的单行或多行文字来建层，层名为相应的单行或多行文字，且每个图层的颜色尽量要不一样，如图中出现了文字1,2,3,4,2，1；那建立出来的层就又4层，名即为1,2,3,4；谢谢！

st788796

参照这个用 Lisp 去做吧

1. (defun c:tt (/ ss strl i)
   
2.   (if (setq ss (ssget '((0 . "text"))))
   
3.     (progn
   
4.       (setq strl (mapcar '(lambda (x)
   
5.        (strcase (xdrx_getpropertyvalue x "TextString"))
   
6.      )
   
7.     (xdrx_pickset->ents ss)
   
8.    )
   
9.      strl (XD::List:RemoveDup strl)
   
10.      i  0
    
11.       )
    
12.       (if (< (length strl) 255)
    
13. (mapcar '(lambda (x) (xdrx_layer_make x (setq i (1+ i))))
    
14.   strl
    
15. )
    
16.       )
    
17.     )
    
18.   )
    
19.   (princ)
    
20. )

(defun c:tt (/ ss strl i)<br />   (if (setq ss (ssget '((0 . "text"))))<br />     (progn<br />       (setq strl (mapcar '(lambda (x)<br />        (strcase (xdrx_getpropertyvalue x "TextString"))<br />      )<br />     (xdrx_pickset->ents ss)<br />    )<br />      strl (XD::List:RemoveDup strl)<br />      i  0<br />       )<br />       (if (< (length strl) 255)<br /> (mapcar '(lambda (x) (xdrx_layer_make x (setq i (1+ i))))<br />   strl<br /> )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

newer

上图吧，仔细说，你图中所有的文字都建层？ 没例外？ 专门为建层写的文字？

chenbing111

st788796 发表于 2013-10-25 11:27
参照这个用 Lisp 去做吧

颜色都是空白呢？最好图层颜色也能随机一下

st788796

chenbing111 发表于 2013-10-28 09:45
颜色都是空白呢？最好图层颜色也能随机一下

图层创建了没有修改实体
你只说了建图层，没说改实体

liuyun242

;;; 功能：按文本内容生产图层名,文本自身图层也修改
(defun text_layer ( / ci i j m n pcc s ss ssi text1)
  (prompt "请选择要生成图层的文本：")
  (setq s (ssget))
  (setq ss (ssget "p" '((0 . "text"))))
  (setq n (sslength ss) )
  (setq pcc (list 1 2 3 4 5 6 7 8 9 10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200 210 220 230 240 11 21 31 41 51 61 71 81 91 101 111 121 131 141 151 161 171 181 191 201 211 221 231 241))
  (setq i 0 ci (length pcc) k 0)
  (repeat n
    (setq ssi (ssname ss i)
          i (1+ i)
    )
    (setq m (entget ssi))
    (setq text1 (cdr (assoc 1 m)))
    (setq text1 (vl-string-translate "/*()~" "XXXXX" text1))
    (setq text1 (vl-string-subst "X" "XX" text1))   
    ;(setq text1 (strcat "B" text1))
    (if (null (tblobjname "layer" text1))
  (progn
    (setq k (1+ k))
    (setq j (cond
              ((<= k ci)
                (nth (1- k) pcc)
              )
              ((> k ci)
                (nth (rem k ci) pcc)
              )
            )
    )                                       ; (princ (strcat "\nj= " (itoa j)))
                                       ; (command "_layer" "m" text1 "c" j "" "")
    (mklayer text1 j)
  )
)

    (setq m (subst
              (cons 8 text1)
              (assoc 8 m)
              m
            )
    )
   
   ;
    (entmod m)
  )
  (princ)
)
;entmake建立图层
(defun mklayer (na cc / el xt)
  (setq cc (rem cc 256))
  (setq el '((0 . "LAYER") (100 . "AcDbSymbolTableRecord")
         (100 . "AcDbLayerTableRecord")
        )       
  )
  (setq xt "Continuous")
    (entmake (append
             el
             (list (cons 2 na) (cons 62 cc) (cons 6 xt) (cons 70 0))
           ))
)

st788796

liuyun242 发表于 2013-10-28 19:37
;;; 功能：按文本内容生产图层名,文本自身图层也修改
(defun text_layer ( / ci i j m n pcc s ss ssi tex ...

你这样写还不如用 command  m

chenbing111

st788796 发表于 2013-10-28 18:00
图层创建了没有修改实体
你只说了建图层，没说改实体

恩 是的 没说修改实体 但是要求新建立的图层的颜色要求尽量不一样的嘛

chenbing111

st788796 发表于 2013-10-28 18:00
图层创建了没有修改实体
你只说了建图层，没说改实体

如图，建立的图层，颜色尽量不一样，并没说要去修改图中的实体哈 ，只是说图层而已

chxl5878

顶顶顶顶顶顶顶顶