TheSwamp
CAD Forums => CAD General => Topic started by: VerticalMojo on December 19, 2003, 03:06:01 PM
-
I have a block with attributes that is created in its original layers.....
I want to change the color of the blocks and the attributes without affecting all the blocks. I was able to change the color of the attributes but not the block itself. Is there a way to do this?
Thanks
-
Do you mean just one of the many instances of that block or would you like to change all of the blocks in the drawing to be on layer 0 with the color set to 'bylayer'?
Because I have a LISP routine that does just that.
-
I didn't write this but I also don't know who did. I use it all of the time and it works great!
; 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 c:FB () (d_FixBlock))
;;;(fb)
(princ)
-
Using LT2000...... Thanks though...... I could use that at home!
I just want to change the color of the particular block. I don’t want it to affect any of the other blocks. I was thinking since I was able to change the color of the attribute without it changing the others then I could do it to the object itself......
-
oooo... not that I know of. Unless the block was created with the colors set to "BYBLOCK".
-
If each block is an xref with a different referring name, you can change the colors of the objects as long as they are bylayer.
-
If the block was defined entirely on layer 0 with color set to bylayer, you can only change the color by manipulating the layer the block is on. Otherwise exploding and redefining may be the only way in LT.
-
That's what I thought KEB......
Nivuahc, I have access to a full blown version and that LISP routine did help me change them......
Thanks everybody! :D
-
If the block was defined entirely on layer 0 with color set to bylayer, you can only change the color by manipulating the layer the block is on. Otherwise exploding and redefining may be the only way in LT.
If the block is created using layer 0 and color BYBLOCK, you can change the color of the inserted block to anything you wish.
-
True enough cadaver
-
because of our cad standards where i work i would need that routine to place the information by layer. what modifations would the above routine need to place the information within the block to layer zero, colour and linetype to bylayer?
Thanks in advance
Diarmuid