Program to change block entitties color to bylayer
I have an ongoing issue with a few South American customers, who like the color yellow, probably because they use a black background for their CAD station. The main issue is that they often color entities inside a block by explicitly assigning that color, rather than using Bylayer.
I have tried 4 different LISP or VBA routines that I have found on the Internet that should change the objects inside a block to be layer 0 and colored bylayer. But, none of them have worked on my v14 Platinum. I have also searched the Bricsys application catalog without success.
Does anyone know of a program that is compatible with BricsCAD, that can accomplish what I want?
Thanks for any suggestions.
-Joe
For reference, here are two of the LISP programs I found, that didn't work
;; BlockSParts0Bylayer.lsp
;; = change all Parts of definitions of Selected Block(s) [other
;; than on Layer Defpoints] to Layer 0 with Color ByLayer
;; Kent Cooper, last edited 4 November 2014
(vl-load-com)
(defun C:BP0B (/ *error* doc nametolist blkss inc blk blknames ent edata obj)
princ ("Type BP0B to start command. Note the 0 is a ZERO")
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
); if
(vla-endundomark doc)
(princ)
); defun - *error*
(defun nametolist (blk / blkobj blkname); get Block name and put it into list of names
(if (= (logand (cdr (assoc 70 (entget blk))) 4) 0) ; not an Xref
(progn
(setq
blkobj (vlax-ename->vla-object blk)
blkname
(vlax-get-property blkobj
(if (vlax-property-available-p blkobj 'EffectiveName) 'EffectiveName 'Name)
; to work with older versions that don't have dynamic Blocks
); ...get-property & blkname
); setq
(if
(not (member blkname blknames)); name not already in list
(setq blknames (append blknames (list blkname))); then -- add to end of list
); if
); progn
); if
); defun -- nametolist
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc); = Undo Begin
(if (setq blkss (ssget '((0 . "INSERT")))); User selection of any number of Blocks/Minserts/Xrefs
(progn ; then
(repeat (setq inc (sslength blkss)); get names from initial selection
(setq blk (ssname blkss (setq inc (1- inc))))
(nametolist blk)
); repeat
(while (setq blk (car blknames)); as long as there's another Block name in list
;; done this way instead of via (repeat) or (foreach), so it can add nested Blocks' names to list
(setq ent (tblobjname "block" blk)); Block definition as entity
(while (setq ent (entnext ent)); then -- proceed through sub-entities in definition
(setq edata (entget ent))
(if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list
(if (not (member '(8 . "Defpoints") edata)); process all entities NOT on Layer Defpoints
(progn
(setq obj (vlax-ename->vla-object ent))
(vla-put-layer obj "0"); to Layer 0
(vla-put-color obj 256); color ByLayer
(if (wcmatch (vla-get-ObjectName obj) "*Dimension,*Leader")
(foreach prop '(DimensionLineColor ExtensionLineColor TextColor)
;; not all such entity types have all 3 properties, but all have at least one
(if (vlax-property-available-p obj prop)
(vlax-put obj prop 256); ByLayer
); if
); foreach
); if
); progn
); if
); while -- sub-entities
(setq blknames (cdr blknames)); take first one off
); while
(command "_.regen")
); progn
(prompt "\nNo Block(s) selected.")
); if [user selection]
(vla-endundomark doc); = Undo End
(princ)
); defun
==================================================
PROGRAM NUMBER TWO
==================================================
;FixBlock.lsp [June 30, 1998]
;
; Copyright 1996 - 1998 ManuSoft
;
; Freeware from:
; ManuSoft
; http://www.manusoft.com
;
; Redefines all or selected blocks so that all entities are on
; layer '0' (zero), with color 'BYBLOCK'.
;
; Load function, then enter FIXBLOCK to redefine selected blocks
; so that all entities are on layer '0', color 'BYBLOCK'.
;
(defun C:FixBlock (/ ss cnt idx blkname donelist Grp Update)
(defun Grp (gc el) (cdr (assoc gc el)))
(defun Update (bname / ename elist)
(setq ename (tblobjname "BLOCK" bname))
(if
(and ename (zerop (logand 52 (Grp 70 (entget ename '(""))))))
(progn
(while ename
(setq elist (entget ename '(""))
elist (subst '(8 . "0") (assoc 8 elist) elist)
elist (if (assoc 62 elist)
(subst '(62 . 0) (assoc 62 elist) elist)
(append elist '((62 . 0)))))
(entmake elist)
(setq ename (entnext ename)))
(if (/= "ENDBLK" (Grp 0 elist))
(entmake '((0 . "ENDBLK") (8 . "0") (62 . 0))))
'T))
)
(if (> (logand (Grp 70 (tblsearch "layer" "0")) 1) 0)
(princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
(progn
(if
(progn
(princ "\nPress to fix all defined blocks\n")
(setq cnt 0
ss (ssget '((0 . "INSERT")))))
(progn
(setq idx (sslength ss))
(while (>= (setq idx (1- idx)) 0)
(if (not (member (setq blkname (Grp 2 (entget (ssname ss idx)))) donelist))
(progn
(if (Update blkname) (setq cnt (1+ cnt)))
(setq donelist (cons blkname donelist))))))
(while (setq blkname (Grp 2 (tblnext "BLOCK" (not blkname))))
(if (Update blkname) (setq cnt (1+ cnt)))))
(princ (strcat "\n" (itoa cnt) " block" (if (= cnt 1) "" "s") " redefined\n"))))
(princ)
)
;End-of-file
Comments
-
;FixBlock.lsp [June 30, 1998]
;
; Copyright 1996 - 1998 ManuSoft
;
; Freeware from:
; ManuSoft
; http://www.manusoft.com
;
; Redefines all or selected blocks so that all entities are on
; layer '0' (zero), with color 'BYBLOCK'.
;
; Load function, then enter FIXBLOCK to redefine selected blocks
; so that all entities are on layer '0', color 'BYBLOCK'.
;Work as advertised for me in V19.
0 -
FixBlock.lsp works in V14 as well. But it is an older program that does not take object associativity and draworder into account.
0 -
Ouh, is it so hard to reach objects inside of Blocks.
You need an own Software to do so ?
(I get scared when I see code lines ....)I thought there would be an Option inside Bricscad to
Select ALL Elements (Solids and Blocks) in a file to edit
in Property Panel ....My "South German" clients send my Revit Exports with
8000 Blocks + Solids but just 2 hand full of Layers.
Somehow Material assignments get lost and switch to
By Layer.
The only differentiation of the different Object Types
on a same Layer is Color by Object and Transparency
by Object.
I find Bricscad's Select Similar pretty limited but it works
to separate Objects and assign to new Layers - for Solids.But for Objects inside Blocks it needs a Script that needs
to Open and Edit each Block,
in a fashion I would do this manually one by one ?0 -
@Roy Klein Gebbinck said:
Try:
http://www.b-k-g.nl/bkg_setbylayer.htmlThank you very much. Yesterday, I spent two hours doing what this routine took a few seconds to do on a very large drawing. But, it will save many hours of work for future drawings I get from this customer, as the project continues.
In regards to the Application Catalog. I was not able to find the application catalog page by browsing from the Bricsys web site. Though, I eventually found it by just doing an internet search. I have already sent them a support request describing my difficulty with this.
-Joe
0 -
Re: FixBlock.lsp
There is a newer re-written version that I often use when addressing that particular pesky problem .
Works fine on V19.
http://www.draftsperson.net/index.php?title=FixBlock_-_Free_LISP0 -
I spent two hours doing what this routine took a few seconds to do on a very large drawing.
Interesting.
But basically such a program has to do the same steps for blocks
as I would have to do manually ?
Like :
Select 1st Block, Block Edit to open, search/select for objects, ....Or asking from the opposite side,
there isn't something that globally allows standard Tools or Commands
to manipulate the Block Definition Part of the Design File Content
to be treated just like standard Geometry ?0 -
At least in my v14, there were no utilities to do what I had to do manually, before I got a working program from Roy Klein Gebbinck.
To be clear, what I did (before I had the program) is to edit a block that had the problem, select its entities, and change the color to be byblock. This had to be done one block at a time.
-Joe
0 -
Yes, and I think (?) Roys Software does basically the same.
So I wondered that you said it was so fast.I think in my case there would be around 5000+ Blocks.
And I would expect that could need some hours.
I had similar before, but just a small part of the project.I finally decided to explode all Blocks being the smaller pain.
Just about 18 Layers and maybe max 5 different Colors by Object for
each. So I could separate all Objects manually and assign them to new
Layers and Material by Layer.Thousands of Block (from Families) used
by 1 Instance only though. Of course I lost the 100 + Blocks
with multiple instances too.
But OpenGL did no more lag.But if I get such projects more oiften,
I learned I need an App for that.(was much more difficult in reality, as Objects aren't always on the
Layers they belong to and Materials (300+) either)0
