need a lisp routine to work on layers

[jimpcfd]

Hi All

 

i get a regular problem when one of my customers sends me a dxf file, all objects are on one layer but are different colours, what i need is a routine that will put all the colours onto separate layers, maybe make the layers 1 - 8 but keeping the colours as the orginal (we never get more than 8 colours).

 

if a routine exist then can some point me to it ?

 

cheers

jimpcfd

[Lee Mac]

I have an old routine that reads a CSV containing information about which layers the colours are 'mapped' to (and the new layer colours and linetypes) then processes and purges the file.

 

Is that something you are interested in?

[jimpcfd]

Hi Lee

 

many thanks,that sounds like it worth a look, i guess you are saying that the text file has the mapped layer names and it change the dxf colours to layers ?

 

cheers

Jim

[David Bethel]

Maybe something with brute force:

 

[b][color=BLACK]([/color][/b]defun ent2clay [b][color=FUCHSIA]([/color][/b]/ ss en ed[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                   cl [b][color=GREEN]([/color][/b]if [b][color=BLUE]([/color][/b]assoc 62 ed[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 62 ed[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 256[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]entmod [b][color=GREEN]([/color][/b]subst [b][color=BLUE]([/color][/b]cons 8 [b][color=RED]([/color][/b]itoa cl[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]assoc 8 ed[b][color=BLUE])[/color][/b] ed[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]ssdel en ss[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

-David

[Tharwat]

Perhaps ...

 

(defun c:test (/ ss j vl Nme co)
 ; Tharwat 08. 06. 2011
 (vl-load-com)
 (if (setq ss (ssget "_:L"))
   (repeat (setq j (sslength ss))
     (setq sset (ssname ss (setq j (1- j))))
     (setq vl (vlax-ename->vla-object sset))
     (if
       (not
         (tblsearch "LAYER"
                    (setq Nme (rtos (setq co (vla-get-color vl)) 2 0))
         )
       )
        (progn
          (entmakex (list (cons 0 "LAYER")
                          (cons 100 "AcDbSymbolTableRecord")
                          (cons 100 "AcDbLayerTableRecord")
                          (cons 2 Nme)
                          (cons 70 0)
                          (cons 62 co)
                    )
          )
          (vla-put-layer vl Nme)
        )
     )
     (if (not (eq (atoi (vla-get-layer vl)) (vla-get-color vl)))
       (vla-put-layer vl co)
     )
   )
   (princ)
 )
 (princ)
)

 

Tharwat

[Lee Mac]

Hi Lee

 

many thanks,that sounds like it worth a look, i guess you are saying that the text file has the mapped layer names and it change the dxf colours to layers ?

 

cheers

Jim

 

Sorry Jim, my mistake - the code I had was for mapping sets of layers to other layers, not colours.

 

Though I'm pretty sure David's code will do what you want, he's usually spot on

[alanjt]

(defun c:LayerByColor (/ ss i d)
 (if (setq ss (ssget "_X" '((-4 . "<") (62 . 256))))
   (repeat (setq i (sslength ss))
     (entmod (subst (cons 8 (itoa (cdr (assoc 62 (setq d (entget (ssname ss (setq i (1- i)))))))))
                    (assoc 8 d)
                    d
             )
     )
   )
 )
 (princ)
)

[alanjt]

And just because it's easy...

 

(defun c:LayerByLinetype (/ ss i d)
 (if (setq ss (ssget "_X" '((-4 . "<NOT") (6 . "ByLayer") (-4 . "NOT>"))))
   (repeat (setq i (sslength ss))
     (entmod (subst (cons 8 (cdr (assoc 6 (setq d (entget (ssname ss (setq i (1- i))))))))
                    (assoc 8 d)
                    d
             )
     )
   )
 )
 (princ)
)

[jimpcfd]

many thanks alanjt, the bycolor one works a treat, as someone whom is trying to get to grips with Lisp (lost((11(1+2+3)2))it) etc etc etc !!!.

any chance you could give me some idea how layerbycolor works ?

 

cheers

Jim

[alanjt]

many thanks alanjt, the bycolor one works a treat, as someone whom is trying to get to grips with Lisp (lost((11(1+2+3)2))it) etc etc etc !!!.

any chance you could give me some idea how layerbycolor works ?

 

cheers

Jim

 

(defun c:LayerByColor (/ ss i d)
 (if (setq ss (ssget "_X" '((-4 . "<") (62 . 256)))) ; selects only objects with a object level color (up to 255)
   (repeat (setq i (sslength ss)) ; steps through the selection set
     (entmod ; modifies the object with a new DXF list
       (subst ; substitutes one dxf pair for another
         (cons 8 ; creating a dotted pair for a new layer. I'm also exploiting the fact that one can define a new layer with entmod as I am without actually having to create it.
               (itoa ; converts integer to string
                 (cdr (assoc 62 ; extracting the object's color
                             (setq d (entget ; extracting entity's DXF data
                                       (ssname ss (setq i (1- i))) ; extracting entity from ssget selection set
                                     )
                             )
                      )
                 )
               )
         )
         (assoc 8 d) ; the DXF dotted pair I want to replace
         d ; the DXF list
       )
     )
   )
 )
 (princ)
)