Author Topic: force block entities layer to '0' and color 'bylayer' ?  (Read 11288 times)

0 Members and 1 Guest are viewing this topic.

Robb

  • Guest
force block entities layer to '0' and color 'bylayer' ?
« on: November 04, 2004, 07:57:55 PM »
Any lisps to do this? I have a bunch of blocks that the entities color and layer are forced... want to set them to layer 0 and color bylayer.

Thanks!

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
force block entities layer to '0' and color 'bylayer' ?
« Reply #1 on: November 04, 2004, 09:04:34 PM »
Seems like I saw an application to do just that in the Freebie forum at www.resourcecad.com
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

hudster

  • Gator
  • Posts: 2848
force block entities layer to '0' and color 'bylayer' ?
« Reply #2 on: November 05, 2004, 07:23:23 AM »
Try this program NEST

it costs $15 to register, but in combination with the filter command you have a very powerful tool for changing any nested object.
Revit BDS 2017, 2016, 2015, 2014, AutoCAD 2017, 2016, Navisworks 2017, 2016, BIM360 Glue

hendie

  • Guest
force block entities layer to '0' and color 'bylayer' ?
« Reply #3 on: November 05, 2004, 07:39:42 AM »
Hudster, what on earth are you doing over at that despicable place ?  :P

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
force block entities layer to '0' and color 'bylayer' ?
« Reply #4 on: November 05, 2004, 09:13:48 AM »
$15 for a handful of LISP? Man, I have to start selling this stuff.

But not just yet, this 10 minute effort is for free:

Code: [Select]
(defun c:DrawingToByLayer

    ;;-----------------------------------------------------------------
    ;;
    ;;  Copyright © 2004 Michael Puckett. All Rights Reserved
    ;;
    ;;-----------------------------------------------------------------
    ;;
    ;;  Forces the entire drawing to "ByLayer" (even xrefs for
    ;;  the lifetime of the session or until an xref reload
    ;;  occurs).
    ;;
    ;;  Forces block definition child entities to layer "0".
    ;;
    ;;  Existing attributes are forced to the same layer the
    ;;  parent block reside on.
    ;;
    ;;  Nominally tested, let me know if you find anything wonky.
    ;;
    ;;  * Use at your own risk. Please test on a dummy dwg *
    ;;
    ;;-----------------------------------------------------------------

    (   /
        _UnLockAllLayers
        _LockLayers
        _ObjectToLayerZero
        _ObjectToByLayer
        _DocumentToByLayer
        _Main
    )

    (defun _UnLockAllLayers ( document / result )
        (vlax-for layer
            (vlax-get-property
                document
               'Layers
            )
            (cond
                (   (eq :vlax-true
                        (vlax-get-property
                            layer
                           'Lock
                        )
                    )
                    (vlax-put-property
                        layer
                       'Lock
                        :vlax-false
                    )
                    (setq result
                        (cons layer
                            result
                        )
                    )
                )
            )
        )
        result
    )

    (defun _LockLayers ( layers )
        (foreach layer layers
            (vlax-put-property
                layer
               'Lock
                :vlax-true
            )
        )
    )

    (defun _ObjectToLayerZero ( object )
        (vlax-put-property object
           'Layer
           "0"
        )
    )

    (defun _ObjectToByLayer ( obj / layer )
        (foreach property '((Color . 256)(Linetype . "ByLayer"))
            (vl-catch-all-apply
               'vlax-put
                (list
                    obj
                    (car property)
                    (cdr property)
                )
            )
        )
        (cond
            (   (and
                    (eq "AcDbBlockReference"
                        (vlax-get
                            obj
                           'ObjectName
                        )
                    )
                    (eq :vlax-true
                        (vlax-get-property
                            obj
                           'HasAttributes
                        )
                    )
                )
                (setq layer (vlax-get-property obj 'Layer))
                (foreach child (vlax-invoke obj 'GetAttributes)
                    (_ObjectToByLayer child)
                    (vlax-put-property child 'Layer layer)
                )
            )
        )
    )

    (defun _DocumentToByLayer ( document )
        (vlax-for block (vlax-get-property document 'Blocks)
            (if
                (eq :vlax-true
                    (vlax-get-property block
                       'IsLayout
                    )
                )
                (vlax-for object block
                    (_ObjectToByLayer object)
                )
                (vlax-for object block
                    (_ObjectToByLayer object)
                    (_ObjectToLayerZero object)
                )
            )
        )
    )

    (defun _Main ( / document lockedLayers )
        (setq lockedLayers
            (_UnlockAllLayers
                (setq document
                    (vlax-get-property
                        (vlax-get-acad-object)
                       'ActiveDocument
                    )
                )
            )
        )
        (_DocumentToByLayer document)
        (_LockLayers lockedLayers)
        (princ)
    )

    (_Main)

)


Edit (1): Added force entities to layer "0", attributes to parent block's layer.
Edit (2): Modified _DocumentToByLayer function to make it faster.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

David Bethel

  • Swamp Rat
  • Posts: 656
force block entities layer to '0' and color 'bylayer' ?
« Reply #5 on: November 05, 2004, 09:50:58 AM »
This is a little dangerous as it forces all block table entities in the entire drawing to layer "0" and color 256.  It does not edit attributes.

Code: [Select]

(defun c:upb (/ tdef fe ed)
  (while (setq tdef (tblnext "BLOCK" (not tdef)))
         (princ (strcat "\n" (strcase (cdr (assoc 2 tdef)))))
         (setq fe (cdr (assoc -2 tdef)))
         (while fe
             (setq ed (entget fe)
                   ed (subst '(8 . "0") (assoc 8 ed) ed)
                   ed (if (assoc 62 ed)
                          (subst '(62 . 256) (assoc 62 ed) ed)
                          (append ed '((62 . 256)))))
             (entmod ed)
             (setq fe (entnext fe))))
  (prin1))



-David
R12 Dos - A2K

ronjonp

  • Needs a day job
  • Posts: 7526
force block entities layer to '0' and color 'bylayer' ?
« Reply #6 on: November 05, 2004, 11:28:32 AM »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Andrew H

  • Guest
force block entities layer to '0' and color 'bylayer' ?
« Reply #7 on: November 08, 2004, 05:51:13 PM »
Here's one I use all the time. I's a lifesaver.

Code: [Select]
; 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))

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
force block entities layer to '0' and color 'bylayer' ?
« Reply #8 on: November 08, 2004, 08:44:47 PM »
« Last Edit: July 15, 2006, 10:10:15 AM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Robb

  • Guest
:-)
« Reply #9 on: November 08, 2004, 11:04:50 PM »
WOW! Awesome! Thanks a bunch!