baker Posted August 1, 2011 Share Posted August 1, 2011 I searched and did not really find the results i was looking for. I am looking for a Lisp that when called, will change every block in the DWG to ByLayer color and line type. I have one i found recently that works, but you have to select each block. this is the Lisp i found.. ; File Name: FIXBLOCK.LSP ; Description: Puts all of a blocks sub-entities on layer 0 with color and ; linetype set to BYBLOCK. The block, itself, will remain on ; its' original layer. ; ;******************************************************************************* (defun d_FixBlock (/ eBlockSel ; Block selection lInsertData ; Entity data sBlockName ; Block name lBlockData ; Entity data eSubEntity ; Sub-entity name lSubData ; Sub-entity data iCount ; Counter ) ;; Redefine error handler (setq d_#error *error* *error* d_FB_Error ) ;_ end setq ;; Set up environment (setq #SYSVARS (#SaveSysVars (list "cmdecho"))) (setvar "cmdecho" 0) (command "._undo" "_group") ;; Get block from user and make sure it's an INSERT type (if (setq eBlockSel (entsel "\nSelect block to change :")) (progn (if (setq lInsertData (entget (car eBlockSel))) (if (= (cdr (assoc 0 lInsertData)) "INSERT") (setq sBlockName (cdr (assoc 2 lInsertData))) (progn (alert "Entity selected is not a block!") (exit) ) ;_ end progn ) ;_ end if (progn (alert "Invalid Block Selection!") (exit) ) ;_ end progn ) ;_ end if ;; Get block info from the block table (setq lBlockData (tblsearch "BLOCK" sBlockName) eSubEntity (cdr (assoc -2 lBlockData)) ) ;_ end setq ;; Make sure block is not an Xref (if (not (assoc 1 lBlockData)) (progn (princ "\nProcessing block: ") (princ sBlockName) (princ "\nUpdating blocks sub-entities. . .") ;; Parse through all of the blocks sub-entities (while eSubEntity (princ " .") (setq lSubData (entget eSubEntity)) ;; Update layer property (if (assoc 8 lSubData) (progn (setq lSubData (subst (cons 8 "0") (assoc 8 lSubData) lSubData ) ;_ end subst ) ;_ end setq (entmod lSubData) ) ;_ end progn ) ;_ end if ;; Update the linetype property (if (assoc 6 lSubData) (progn (setq lSubData (subst (cons 6 "BYBLOCK") (assoc 6 lSubData) lSubData ) ;_ end subst ) ;_ end setq (entmod lSubData) ) ;_ end progn (entmod (append lSubData (list (cons 6 "BYBLOCK")))) ) ;_ end if ;; Update the color property (if (assoc 62 lSubData) (progn (setq lSubData (subst (cons 62 0) (assoc 62 lSubData) lSubData ) ;_ end subst ) ;_ end setq (entmod lSubData) ) ;_ end progn (entmod (append lSubData (list (cons 62 0)))) ) ;_ end if (setq eSubEntity (entnext eSubEntity)) ; get next sub entity ) ; end while ;; Update attributes (idc_FB_UpdAttribs) ) ; end progn (alert "XREF selected. Not updated!") ) ; end if ) ; end progn (alert "Nothing selected.") ) ; end if ;;; Pop error stack and reset environment (idc_RestoreSysVars) (princ "\nDone!") (setq *error* d_#error) (princ) ) ; end defun ;******************************************************************************* ; Function to update block attributes ;******************************************************************************* (defun idc_FB_UpdAttribs () ;; Update any attribute definitions (setq iCount 0) (princ "\nUpdating attributes. . .") (if (setq ssInserts (ssget "x" (list (cons 0 "INSERT") (cons 66 1) (cons 2 sBlockName) ) ;_ end list ) ;_ end ssget ) ;_ end setq (repeat (sslength ssInserts) (setq eBlockName (ssname ssInserts iCount)) (if (setq eSubEntity (entnext eBlockName)) (setq lSubData (entget eSubEntity) eSubType (cdr (assoc 0 lSubData)) ) ;_ end setq ) ;_ end if (while (or (= eSubType "ATTRIB") (= eSubType "SEQEND")) ;; Update layer property (if (assoc 8 lSubData) (progn (setq lSubData (subst (cons 8 "0") (assoc 8 lSubData) lSubData ) ;_ end subst ) ;_ end setq (entmod lSubData) ) ;_ end progn ) ;_ end if ;; Update the linetype property (if (assoc 6 lSubData) (progn (setq lSubData (subst (cons 6 "BYBLOCK") (assoc 6 lSubData) lSubData ) ;_ end subst ) ;_ end setq (entmod lSubData) ) ;_ end progn (entmod (append lSubData (list (cons 6 "BYBLOCK")))) ) ;_ end if ;; Update the color property (if (assoc 62 lSubData) (progn (setq lSubData (subst (cons 62 0) (assoc 62 lSubData) lSubData ) ;_ end subst ) ;_ end setq (entmod lSubData) ) ;_ end progn (entmod (append lSubData (list (cons 62 0)))) ) ;_ end if (if (setq eSubEntity (entnext eSubEntity)) (setq lSubData (entget eSubEntity) eSubType (cdr (assoc 0 lSubData)) ) ;_ end setq (setq eSubType nil) ) ;_ end if ) ; end while (setq iCount (1+ iCount)) ) ; end repeat ) ; end if (command "regen") ) ; end defun ;******************************************************************************* ; Function to save a list of system variables ;******************************************************************************* (defun #SaveSysVars (lVarList / sSystemVar) (mapcar '(lambda (sSystemVar) (setq lSystemVars (append lSystemVars (list (list sSystemVar (getvar sSystemVar))) ) ;_ end append ) ;_ end setq ) ;_ end lambda lVarList ) ;_ end mapcar lSystemVars ) ;_ end defun ;******************************************************************************* ; Function to restore a list of system variables ;******************************************************************************* (defun idc_RestoreSysVars () (mapcar '(lambda (sSystemVar) (setvar (car sSystemVar) (cadr sSystemVar)) ) ;_ end lambda #SYSVARS ) ;_ end mapcar ) ;_ end defun ;******************************************************************************* ; Error Handler ;******************************************************************************* (defun d_FB_Error (msg) (princ "\nError occurred in the Fix Block routine...") (princ "\nError: ") (princ msg) (setq *error* d_#error) (if *error* (*error* msg) ) ;_ end if (command) (if (/= msg "quit / exit abort") (progn (command "._undo" "_end") (command "._u") ) ;_ end progn ) ;_ end if (idc_RestoreSysVars) (princ) ) ;_ end defun ;******************************************************************************* (defun FB () (d_FixBlock)) (fb) (princ) also, i cannot get this lisp to work without apploading each time i need it. Quote Link to comment Share on other sites More sharing options...
BlackBox Posted August 1, 2011 Share Posted August 1, 2011 Why not just use the SETBYLAYER command? Quote Link to comment Share on other sites More sharing options...
baker Posted August 1, 2011 Author Share Posted August 1, 2011 Why not just use the SETBYLAYER command? because i forgot about that command.. lol. Quote Link to comment Share on other sites More sharing options...
BlackBox Posted August 1, 2011 Share Posted August 1, 2011 because i forgot about that command.. lol. lmfao ... Happy to help! :wink: Quote Link to comment Share on other sites More sharing options...
Tharwat Posted August 1, 2011 Share Posted August 1, 2011 because i forgot about that command.. lol. Me too , every time Renderman reminds me of it by his precious words and I keep on forgetting it . My routine is ready to delivery but this command hold my energy LOL.... Quote Link to comment Share on other sites More sharing options...
David Bethel Posted August 2, 2011 Share Posted August 2, 2011 I honestly don't know much about setbyblock, but this should give a bit of flexibility as well [b][color=BLACK]([/color][/b]defun c:blk2def [b][color=FUCHSIA]([/color][/b]/ bl tdef fe fd[b][color=FUCHSIA])[/color][/b] [color=#8b4513];;;GROUP LIST Group_Number Sysvar_Name New_Value[/color] [b][color=FUCHSIA]([/color][/b]setq bl '[b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b] 8 [color=#2f4f4f]"CLAYER"[/color] [color=#2f4f4f]"0"[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b] 6 [color=#2f4f4f]"CELTYPE"[/color] [color=#2f4f4f]"BYLAYER"[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]39 [color=#2f4f4f]"THICKNESS"[/color] 0.0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]48 [color=#2f4f4f]"CELTSCALE"[/color] 1[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]62 [color=#2f4f4f]"CECOLOR"[/color] 256[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq tdef [b][color=MAROON]([/color][/b]tblnext [color=#2f4f4f]"BLOCK"[/color] [b][color=GREEN]([/color][/b]not tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]setq fe [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc -2 tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]princ [b][color=MAROON]([/color][/b]strcat [color=#2f4f4f]"\n"[/color] [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 2 tdef[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]entmake tdef[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]while fe [b][color=MAROON]([/color][/b]setq fd [b][color=GREEN]([/color][/b]entget fe[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]foreach g bl [b][color=GREEN]([/color][/b]cond [b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]not [b][color=PURPLE]([/color][/b]getvar [b][color=TEAL]([/color][/b]nth 1 g[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]assoc [b][color=PURPLE]([/color][/b]nth 0 g[b][color=PURPLE])[/color][/b] fd[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]setq fd [b][color=PURPLE]([/color][/b]subst [b][color=TEAL]([/color][/b]cons [b][color=OLIVE]([/color][/b]nth 0 g[b][color=OLIVE])[/color][/b] [b][color=OLIVE]([/color][/b]nth 2 g[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b] [b][color=TEAL]([/color][/b]assoc [b][color=OLIVE]([/color][/b]nth 0 g[b][color=OLIVE])[/color][/b] fd[b][color=TEAL])[/color][/b] fd[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]T [b][color=RED]([/color][/b]setq fd [b][color=PURPLE]([/color][/b]append fd [b][color=TEAL]([/color][/b]list [b][color=OLIVE]([/color][/b]cons [b][color=GRAY]([/color][/b]nth 0 g[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]nth 2 g[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]entmake fd[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq fe [b][color=GREEN]([/color][/b]entnext fe[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"ENDBLK"[/color][b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]command [color=#2f4f4f]"_.REGENALL"[/color][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] You can manipulate the list bl to your needs. SNVALID Layer Name Linetypes must exist prior to calling this for it work properly. Colors 0-256 It does not address existing ATTRIButes. -David Quote Link to comment Share on other sites More sharing options...
baker Posted August 5, 2011 Author Share Posted August 5, 2011 ahhhh... now i remember.. i want the linework in the blocks to move to layer 0 as well as bylayer for everything else.. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 6, 2011 Share Posted August 6, 2011 Give this a try: (defun c:test ( / acdoc ) ;;----------------------------------------------------------- ;; All block objects to Layer "0", Color/Linetype ByLayer ;; Lee Mac 2011 - www.lee-mac.com ;;----------------------------------------------------------- (vlax-for block (vla-get-blocks (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) ) (if (and (eq :vlax-false (vla-get-islayout block)) (eq :vlax-false (vla-get-isxref block)) ) (vlax-for object block (mapcar (function (lambda ( property value ) (vl-catch-all-apply 'vlax-put-property (list object property value)) ) ) '(layer color linetype) (list "0" acbylayer "BYLAYER") ) ) ) ) (vla-regen acdoc acallviewports) (princ) ) (vl-load-com) (princ) Quote Link to comment Share on other sites More sharing options...
baker Posted August 8, 2011 Author Share Posted August 8, 2011 Lee, you are going to kill me. That is great and i will use that lisp.. Is there a way to have another lisp (or the option in this lisp) to put the block's objects to the layer the block is inserted to? Quote Link to comment Share on other sites More sharing options...
BlackBox Posted August 8, 2011 Share Posted August 8, 2011 Lee, you are going to kill me. That is great and i will use that lisp.. Is there a way to have another lisp (or the option in this lisp) to put the block's objects to the layer the block is inserted to? Consider replacing this line: (list [color=red]"0"[/color] acbylayer "BYLAYER") ... with this one: (list [color=red](vla-get-layer object)[/color] acbylayer "BYLAYER") Quote Link to comment Share on other sites More sharing options...
alanjt Posted August 8, 2011 Share Posted August 8, 2011 Consider replacing this line: (list [color=red]"0"[/color] acbylayer "BYLAYER") ... with this one: (list [color=red](vla-get-layer object)[/color] acbylayer "BYLAYER") I hope the block definition doesn't have many objects. Quote Link to comment Share on other sites More sharing options...
baker Posted August 8, 2011 Author Share Posted August 8, 2011 I hope the block definition doesn't have many objects. i would only use this on simple blocks, 2D blocks like inlets, fire hyds.. etc.. Quote Link to comment Share on other sites More sharing options...
alanjt Posted August 8, 2011 Share Posted August 8, 2011 i would only use this on simple blocks, 2D blocks like inlets, fire hyds.. etc.. He knows what I mean, but I should have been clearer for others. You should store the layer before stepping through the block definition, then you can apply the layer from the variable, instead of 'get'ing the object's layer each time. Quote Link to comment Share on other sites More sharing options...
BlackBox Posted August 8, 2011 Share Posted August 8, 2011 I hope the block definition doesn't have many objects. Touché... I didn't even think of that. Guess that's what I get for responding to a question not intended for me. In an effort to redeem my mistake, perhaps this: (if (and (eq :vlax-false (vla-get-islayout block)) (eq :vlax-false (vla-get-isxref block)) ) [color=blue](progn[/color] (vlax-for object block (mapcar (function (lambda (property value / lay) (vl-catch-all-apply 'vlax-put-property (list object property value)) ) ) '(layer color linetype) (list [color=blue](cond (lay) ((setq lay (vla-get-layer object))))[/color] acbylayer "BYLAYER") ) ) [color=blue](setq lay nil)[/color] [color=blue])[/color] ) (^^ Snip from Lee's code) Now I forget if localizing "lay" to the lambda means (setq lay nil) is still required or not? It's a rough Monday for me. This is not my best showing of skill for sure. LoL Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 8, 2011 Share Posted August 8, 2011 you are going to kill me. That is great and i will use that lisp. You're welcome Is there a way to have another lisp (or the option in this lisp) to put the block's objects to the layer the block is inserted to? The layer on which the block is inserted could potentially be different for each block reference, so this behaviour could not be achieved by modifying the block definition since such modification would be reflected across all inserts. But in any case, If all block objects are on layer "0", they will assume the layer on which the block is inserted anyway, or am I missing something? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 8, 2011 Share Posted August 8, 2011 In an effort to redeem my mistake, perhaps this: That is setting all objects in the block definition to the layer of the first object in the block definition. I think a few of you are getting confused between Definitions and References, the layer on which one or more References are inserted cannot be ascertained from the Block Definition. Quote Link to comment Share on other sites More sharing options...
BlackBox Posted August 9, 2011 Share Posted August 9, 2011 Yeah, that's my mistake. I was very scatter-brained and should not have posted. Sorry for the distraction guys. Quote Link to comment Share on other sites More sharing options...
alanjt Posted August 9, 2011 Share Posted August 9, 2011 That is setting all objects in the block definition to the layer of the first object in the block definition. I think a few of you are getting confused between Definitions and References, the layer on which one or more References are inserted cannot be ascertained from the Block Definition. Generally speaking, a specific block is designated to a specific layer. However, I don't agree with or understand objects within a block definition being on anything other than the "0" layer. You are right, I think the difference between reference and definition hasn't fully been grasped. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.