Set Colour 'By Block' LISP?

[Anonymous]

Hi, I find I often have to open up blocks and change the colour from 'by layer' to 'by block'. Does anyone have a lisp to make this faster and easier? It would be great if I could do multiple blocks at once. There is a useful command setbylayer I just wish there was the same thing for set by block.

[Moshe-A]

@Anonymous  hi,

check this one, let you specify block name and set all it's entities color to byblock.

enjoy

Moshe

(vl-load-com)

(defun c:colorByBlock (/ blkName color)
 (cond
  ((eq (setq blkName (getstring "\nBlock name: ")) "") 
   nil
  )
  ((null (tblsearch "block" blkName))
   (vlr-beep-reaction)
   (prompt (strcat "\nblock " blkName " is not found."))
  )
  ( t
   (setq color (vlax-create-object (strcat "AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2))))
   (vla-put-colorIndex color AcByBlock)
   
   (vlax-for AcDbEntity (vla-item
                          (vla-get-blocks
                               	(vla-get-activedocument
                                   	(vlax-get-acad-object)
                                )
                          )
                          blkName
                        )   
    (vla-put-trueColor AcDbEntity color)  
    (vlax-release-object AcDbEntity)
   ); vlax-for
   
   (princ "\nDone.") 
  )
 ); cond

 (princ) 
); c:colorByBlock

[pendean]

See this other post in the forum https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/set-color-to-quot-byblock-quot-for-e...

HTH

[john.uhden · Accepted solution]

Here's an old one...

(defun C:BB ( / *error* @Anonymous |e |e0 |ent |etyp |done |bname |ans |flag)
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
   ;*                                                                           *
   ;*         BB.LSP     by     John F. Uhden                                   *
   ;*                           2 Village Road                                  *
   ;*                           Sea Girt, NJ  08750                             *
   ;*                                                                           *
   ;* * * * * * * * * * * *  Do not delete this heading!  * * * * * * * * * * * *

   ; Program redefines all entities in a block definition to color BYBLOCK.

   ; v2.1 (10-24-97) corrected (redraw) and (chr 7)
   ; v15.00 (04-07-00) for R15
   ; Revised (11-17-16) for freeware

   (gc)
   (prompt "\nBB v15.00 (c)1994-2000, John F. Uhden, Cadlantic")
   (prompt "\nThis routine will redefine all entities in a block to color BYBLOCK.")
    (or *acad* (setq *acad* (vlax-get-acad-object)))
    (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
    (vla-endundomark *doc*)
    (vla-startundomark *doc*)

   (defun *error* (|err)
      (@reset)
      (if (wcmatch (strcase |err) "*CANCEL*,*QUIT*")
         (vl-exit-with-error "\r                                              ")
         (vl-exit-with-error (strcat "\r*ERROR*: " |err))
      )
   )
   (defun @Anonymous ()
      (vla-endundomark *doc*)
      (if (= (type |e0) 'ENAME) (redraw |e0 4))
      (vl-doc-set '$cv_cmdname "")
      (princ)
   )

   (if (setq |e0 (entsel "\nPick a block to redefine: "))
      (progn
         (setq |e0 (car |e0)
               |ent (entget |e0)
               |etyp (cdr (assoc 0 |ent))
               |flag (cdr (assoc 70 |ent))
         )
         (redraw |e0 3)
         (if (and (= |etyp "INSERT")(= (logand |flag 4) 4))
            (setq |etyp "Xref")
         )
         (if (= |etyp "INSERT")
            (progn
               (setq |bname (cdr (assoc 2 |ent))
                     |e (tblsearch "block" |bname)
                     |e (cdr (assoc -2 |e)) |done nil
               )
               (prompt (strcat "\nBlock name is " |bname "."))
               (initget "Yes No")
               (setq |ans (getkword "\nAre you sure you want to redefine it?  Yes/<No>: "))
               (if (= |ans "Yes")
                  (progn
                     (while (not |done)
                        (setq |ent (entget |e))
                        (if (assoc 62 |ent)
                           (setq |ent (subst (cons 62 0)(assoc 62 |ent) |ent))
                           (setq |ent (append |ent (list (cons 62 0))))
                        )
                        (entmod |ent)(entupd |e)
                        (if (not (setq |e (entnext |e)))(setq |done 1))
                     )
                     (prompt "\nDisplay will be correct after next regen.\n")
                  )
               )
            )
            (prompt (strcat "\nEntity selected is a(n) " |etyp "."))
         )
         (setq |e0 (redraw |e0 4))
      )
   )
   (@reset)
)

Make nothing of the pipe symbol prefix "|."  It's just a style I used before local variables were really local.