Jump to content

All blocks to be set to ByLayer (color and linetype)


baker

Recommended Posts

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.

Link to comment
Share on other sites

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 . :D

 

My routine is ready to delivery but this command hold my energy LOL....

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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")

Link to comment
Share on other sites

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.
Link to comment
Share on other sites

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..

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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. :oops:

 

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

Link to comment
Share on other sites

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? :?

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...