Topic: same text size to layers make

[dussla]

today , i came to my house (= swamp )~~

i meet some difficultiy
wanted process

example )

condition :  there are   24 , 30   5  ..... etc size texts in dwg
                i want to  make   each  size layers about texts
              
process :  
                1. select each text size list
                2. sort size
                3. after  making size list
                4. make size name layers  (   ex:   text-24    text-30  text-5  etc ....)
                5. select   same text each sme size
                6.  send     size 24 txt  to  text-24 layer
                     send     size 30 txt  to text-30 layer

can you understand  ?~
i will wait  without sleeping      

[Lee Mac]

Something like this?

Code: [Select]

(defun c:tSze (/ lays doc PutonLayer ss)
  (vl-load-com)

  (setq lays (vla-get-Layers
               (setq doc (vla-get-ActiveDocument
                           (vlax-get-acad-object)))))

  (defun PutonLayer (obj lay)
    (or (tblsearch "LAYER" lay) (vla-add lays lay))
    (vla-put-layer obj lay))

  (if (ssget "_:L" '((0 . "TEXT,MTEXT")))
    (progn     
      (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
        (PutonLayer obj (strcat "text-" (vl-princ-to-string (vla-get-Height obj)))))
      (vla-delete ss)))

  (princ))


[dussla]

wow  very cool

you are really genius
i like your coding style
you code is short and simple 
so i like you ~
really thank you
because of you , i can sleep  now 

[Lee Mac]

Thanks Dussla, I appreciate it 

[dussla]

lee
pls ,can you modify ,add  some routine


1. i would like to change layer color


2.
   if i  select a certain size text .  
    make text_hegiht layer
   send   a certain size texts to text_height layer


  this routine is 1 select rotuine
can you undetstands my idea ?
sorry many ask ~  

[Lee Mac]

Sorry Dussla, I'm not sure that I understand your intention.

Are you saying that you want to select your text, create one layer, and for the selected text to be on that layer? And as for the colours how would the routine know which colours to use? Or would the user be prompted for a colour every time?

[dussla]

hi lee


1. problem

(defun PutonLayer (obj lay)
    (or (tblsearch "LAYER" lay) (vla-add lays lay))
    (vla-put-layer obj lay)
    (VLA-PUT LAY 123 )  <----------------------
 
   )


yes i will fix number   
i add  code above
but that is not working


2. this routine is error

(defun c:sin (/ lays doc PutonLayer ss)
  (vl-load-com)

  (setq lays (vla-get-Layers
               (setq doc (vla-get-ActiveDocument
                           (vlax-get-acad-object)))))

  (defun PutonLayer (obj lay)
    (or (tblsearch "LAYER" lay) (vla-add lays lay))
   ;(vla-put-color lay 123)
    (vla-put-layer obj lay)
   
      
   
   
   )

   ;
   ; (setq ss (ssget ":s"  (list (cons 0 "insert"))))
   
    (setq ss  (entsel))
   (setq en1 (car ss))
    (setq obj (vlax-ename->vla-object ent))
   (setq textheight    (cdr (assoc 40 (entget en1))))    
       
   (if (setq ss (ssget "x"   (list (cons 0 "*TEXT") (cons 40 textheight))))
      (progn     
         (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
         (PutonLayer obj (strcat "text-" (vl-princ-to-string (vla-get-Height obj))))
         ;(vla-put-color obj 123)
         )
         (vla-delete ss)
      )
   )
  (princ))
    
 

[Lee Mac]

Quick modification, not too pretty:

Code: [Select]

(defun c:tSze (/ lays doc PutonLayer ss)
  (vl-load-com)

  (setq lays (vla-get-Layers
               (setq doc (vla-get-ActiveDocument
                           (vlax-get-acad-object)))))

  (defun PutonLayer (obj lay)
    (or (tblsearch "LAYER" lay) (vla-put-color (vla-add lays lay) 123))
    (vla-put-layer obj lay))

  (if (setq ss (ssget "_+.:E:S" '((0 . "TEXT,MTEXT"))))
    (mapcar
      (function
        (lambda (obj)
          (PutonLayer obj (strcat "text-" (vl-princ-to-string (vla-get-Height obj))))))

      (mapcar (function vlax-ename->vla-object)
              (mapcar (function cadr) (ssnamex (ssget "_X" (list (cons 0 "TEXT,MTEXT")
                                                                 (assoc 40 (entget (ssname ss 0))))))))))
 
  (princ))


[dussla]

thank you 
i tested now
for my work ,. that routine is very useful
really thank you

1 more ask  is below

i  excuteed tsze
and i change  layer color (vla-add lays lay) 123 ->  256
and  i tested it
but color didn't now change


if you are easy time  , pls  slowly modifdy ~~~~~~~~~~~
at any way ,  you are very kindly person ~

[Lee Mac]

Yes, the code doesn't change the colour of existing layers 

[Lee Mac]

This should be quicker also:

Code: [Select]

(defun c:tSze (/ Layer PutonLayer i ss ent Colour)
  (vl-load-com)

  (setq Colour 13)

  (defun Layer (Nme Col)
    (entmake (list (cons 0 "LAYER")                   (cons 100 "AcDbSymbolTableRecord")
                   (cons 100 "AcDbLayerTableRecord")  (cons 2 Nme)
                   (cons 70 0)                        (cons 62 Col))))

  (defun PutonLayer (ent lay col / eLst)
    (or (tblsearch "LAYER" lay) (Layer lay Col))
    (setq eLst (entget (tblobjname "LAYER" lay)))
    (entmod (subst (cons 62 Col) (assoc 62 eLst) eLst))
    (entmod (subst (cons 8  lay) (assoc 8 (entget ent)) (entget ent))))

  (if (and (setq i -1 ss (ssget "_+.:E:S" '((0 . "TEXT,MTEXT"))))
           (setq ss (ssget "_X" (list (cons 0 "TEXT,MTEXT") (setq h (assoc 40 (entget (ssname ss 0))))))))
   
    (while (setq ent (ssname ss (setq i (1+ i))))
      (PutonLayer ent (strcat "text-" (vl-princ-to-string (cdr h))) Colour)))

  (princ))


[dussla]

yes
perpect
becasue of you , mabey i can sleep 
here is pm 9:16
thank you good day ~

[Lee Mac]

You're welcome