Move objects to new layer(s) based upon color??

[mhupp]

I don't know how big your drawing is but depending on how many blocks and entity's their are it could take a min to run thought everything.

Just tested it on a drawing with 2500 entity's that is around 1.7MB in size. it took about 2-3 seconds to run.

 

You could copy a small part of the drawing into a new drawing and run the lisp there to see if it works properly. If it does you probably just need to wait for the lisp to run its course in the main drawing.

 

[jim78b]

Ok i will try thanks

[jim78b]

Sorry tested on a dwg 400 kb! autocad  freeze on cursor for long time!

 

i only need a lisp that convert even from nested blocks, all object to new layer based on colours and linetype .

Edited March 16, 2022 by jim78b

[mhupp]

Everything works on this end. I don't know whats making it freeze. It might be anonymous blocks?

 

@BIGAL

@ronjonp

 

I need at least 15¢

Edited March 16, 2022 by mhupp

[SLW210]

I ran it and it made the layers, but I had to hit escape to get control of the cursor again.

[mhupp]

I think I fixed it. wasn't removing *Paper_Space from the list of blocks.

[ronjonp]

On 3/14/2022 at 1:47 PM, mhupp said:

Sorry I was mistaking @jim78b for the original poster.

Try this. don't worry about making layers first. this will make them as needed. might error if they are true colors and not 0 - 256.

 

(defun C:layerColor (/ SS ent lay e blkname blklst entlst)
  (vl-load-com)
  (if (setq SS (ssget "_X" '((8 . "0") (-4 . "<NOT") (0 . "INSERT") (-4 . "NOT>") (410 . "Model"))))
    (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq ent (vlax-ename->vla-object obj))
      (setq lay (itoa (vla-get-Color ent)))
      (if (not (tblsearch "layer" lay))
        (entmake (list (cons 0 "LAYER")
                       (cons 100 "AcDbSymbolTableRecord")
                       (cons 100 "AcDbLayerTableRecord")
                       (cons 2 lay)
                       (cons 62 (atof lay))
                       (cons 70 0)
                 )
        )
      )
      (vla-put-layer ent lay)
    )
  )
  (if (setq SS (ssget "_X" '((8 . "0") (0 . "INSERT") (410 . "Model"))))
    (progn
      (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (if (not (vl-position (setq blkname (cdr (assoc 2 (entget blk)))) blklst))
          (setq blklst (cons blkname blklst))
        )
      )
      (foreach blkname blklst
        (setq ent (tblobjname "BLOCK" blkname))
        (while (setq ent (entnext ent))
          (setq entlst (cons ent entlst))
        )
        (foreach ent entlst
          (setq ent (vlax-ename->vla-object ent))
          (setq lay (itoa (vla-get-Color ent)))
          (if (not (tblsearch "layer" lay))
            (entmake (list (cons 0 "LAYER")
                           (cons 100 "AcDbSymbolTableRecord")
                           (cons 100 "AcDbLayerTableRecord")
                           (cons 2 lay)
                           (cons 62 (atof lay))
                           (cons 70 0)
                     )
            )
          )        
          (vla-put-layer ent lay)
        )
      )
    )
  )
  (princ)
)

 

updated code so if there is multiple of the same block it only gets processed once.

@mhupp FWIW

;; This
(setq ss (ssget "_X" '((8 . "0") (-4 . "<NOT") (0 . "INSERT") (-4 . "NOT>") (410 . "Model"))))
;; Is the same as this
(setq ss (ssget "_X" '((8 . "0") (0 . "~INSERT") (410 . "Model"))))

 

[jim78b]

I TRIED the lisp :

 

Command: LAYERCOLOR
; error: bad DXF group: (62 . 256.0)
Command:

[BIGAL]

(62 . 256) is correct an integer. 

[jim78b]

what should I do?

[mhupp]

are you using something other than mech 2013?

[jim78b]

I using autocad 2022

[jim78b]

18 hours ago, ronjonp said:

@mhupp FWIW

;; This
(setq ss (ssget "_X" '((8 . "0") (-4 . "<NOT") (0 . "INSERT") (-4 . "NOT>") (410 . "Model"))))
;; Is the same as this
(setq ss (ssget "_X" '((8 . "0") (0 . "~INSERT") (410 . "Model"))))

 

i need the code working in nested block please

[ronjonp]

38 minutes ago, jim78b said:

i need the code working in nested block please

Have you tried to solve this yourself? Maybe you need to start learning to write code for yourself or at least troubleshoot what is provided to you. @mhupp has been more than generous.

[mhupp]

msg me this list.

 

(defun c:blknames ()
  (setq blklst (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for blk blklst (and (eq "AcDbBlockReference" (vla-get-ObjectName blk)))
    (setq lst (cons (vla-get-Name blk) lst))
  )
  lst
)

 

maybe *Model_Space and *Paper_Space are Different in Autocad.

[jim78b]

This is not your problem 

[jim78b]

Should i insert this in your code ?

Edited March 17, 2022 by jim78b

[ronjonp]

50 minutes ago, jim78b said:

This is not your problem 

Then don't quote me asking for additional features. 

 

And again: Have you tried to solve this yourself?

Edited March 17, 2022 by ronjonp

[jim78b]

This is why I ask it here. because there are people available and competent, not because I enjoy asking it.

[jim78b]

C:BLKNAMES
Command: BLKNAMES
("A$C1ad67182" "2T31_V" "A$C5673ea10" "A$C62e16c65" "A$C66ff285b" "A$Cbf163aae" "2T20_V" "A$C4d1b9b0b" "A$C85313894" "Dettaglio2d1" "SCAVO 3L" "A$Cf43eeff8" "2PT22-23" "1PT19_V" "1PT20" "1PT17_V" "1PT06_V" "1PT04-05_V" "1T13_S" "FORMATO_A0" "LSA" "A$Cc448457d" "A$Cd3f2d9b4" "C1904-00554" "A$C2f692ae2" "1T25_V" "1T01_V" "A$C90dace7d" "A$C8db373e1" "A$C6d56e7a1" "C1904-00607" "A$Cc7716113" "PSB" "CARTIGLIO" "C1904-00388" "1F33" "1F28" "1F47" "1F22" "1F10" "1F14" "1F4" "A$Cf3435054" "A$C90ddd5d3" "A$C65c9af5e" "A$Cf6e71e33" "Scatola a cuneo 40t" "1904-00361" "DIM_FREC" "*PAPER_SPACE" "*MODEL_SPACE")
Command: