rename a block and move it to a new layer

February 17, 2015

Hi.I have a little problem with my drawings.I am a Topografer and I use attribiute blocks to insert the measure points in autocad. In many cases i need to put some of this points to a new layer and hide them. All my points have the same block name so the only way to put some of them to another layer is to rename the selected blocks. So i am trying to find a lisp that remane only the select blocks and put them to a new layer. Can any one have a lisp to do this ?

look the attach drawing

Thanks

test.dwg

February 17, 2015

Hi prodromosm

Silly question, 'Why do you have rename the selected blocks?'

Why not just select and change to another layer, no plottable, or freeze...

Henrique

February 17, 2015

how to do this? This attribiute block have 3 layer.I want to put some of them to another layer not all of them. Can you give me an example?

February 17, 2015

If you re-defined the block, so that the Point and point number were on layer 0, then you could see which points were on which layer very easily.

February 17, 2015

Do you have a lisp code to re-defined the block and put it to another layer?

February 17, 2015

I have never needed one, thank you. I would expect the block to be suitably defined before I used it.

February 17, 2015

I would expect the block to be suitably defined before I used it.

Why you say that ? i need to have 4 layers in this block because if idon't need the desc or elevetion i can layer off them

February 17, 2015

I was only suggesting putting the Point number and/or point on layer 0. The other attributes would remain on their own layers.

It is all about planning the use of blocks, then you would have no need to rename blocks.

In fact you would only have to put the Point on layer 0, because you can always make a point disappear.

February 17, 2015

how to do this? This attribiute block have 3 layer.I want to put some of them to another layer not all of them. Can you give me an example?

Do you need to change some blocks, or just some attributes in some blocks?

Changing your "point" block, to a frozen layer, you'll not see the block, nor the attributes, also if a non-plottable layer, those blocks will not be printed.

Henrique

February 17, 2015

Do you need to change some blocks, or just some attributes in some blocks?
Changing your "point" block, to a frozen layer, you'll not see the block, nor the attributes, also if a non-plottable layer, those blocks will not be printed.

Yes but if i copy or rotate my drawings i will have problem with the frozen blocks.I want any time to lay on the layer and see this points in the correct position. This is the big problem to me and i don't know any other way to do it

February 17, 2015

Sorry prodromosm, I'm not following you...

In your first post, you've stated

In many cases i need to put some of this points to a new layer and hide them.

One way to 'hide them' is freezing the layer...

Henrique

February 17, 2015

no in my first post i say

trying to find a lisp that remane only the select blocks and put them to a new layer

February 17, 2015

Actually you said both those things in the same post but whose keeping track right?

February 17, 2015

no in my first post i say

No???

Ok, my bad!!!

I was just trying to give you a solution to your problem, without clone the block, insert the new block in a new layer, copy attributes from old to new, delete the old block, and all this in a new code...

Perhaps someone else already has such a code.

Henrique

February 17, 2015

OK. I find Lee code to rename the blocks

;;-----------------=={ Copy/Rename Block Reference }==------------------;;
;;                                                                      ;;
;;  This program allows a user to copy and/or rename a single block     ;;
;;  reference in the working drawing.                                   ;;
;;                                                                      ;;
;;  Many existing programs enable the user to rename the block          ;;
;;  definition for a given block reference, with the new name           ;;
;;  subsequently reflected across all references of the block           ;;
;;  definition in the drawing. However, this program will allow a       ;;
;;  single selected block reference to be renamed (or for the user to   ;;
;;  create a renamed copy of the selected block reference), by          ;;
;;  generating a duplicate renamed block definition for the selected    ;;
;;  block.                                                              ;;
;;                                                                      ;;
;;  The program may be called from the command-line using either 'CB'   ;;
;;  to create a renamed copy of a selected block reference, or 'RB' to  ;;
;;  simply rename the selected block reference.                         ;;
;;                                                                      ;;
;;  Following selection of a block reference, the user is prompted to   ;;
;;  specify a name for the selected/copied block reference; a default   ;;
;;  block name composed of the original block name concatenated with    ;;
;;  both an underscore and the minimum integer required for uniqueness  ;;
;;  within the block collection of the active drawing is offered.       ;;
;;                                                                      ;;
;;  The program will then proceed to duplicate the block definition     ;;
;;  using the new block name. To accomplish this without resulting in   ;;
;;  a duplicate key in the block collection of the active drawing, the  ;;
;;  program utilises an ObjectDBX interface to which the block          ;;
;;  definition of the selected block reference is deep-cloned, renamed, ;;
;;  and then deep-cloned back to the active drawing. This method also   ;;
;;  enables Dynamic Block definitions to be successfully copied         ;;
;;  & renamed.                                                          ;;
;;                                                                      ;;
;;  Finally, this program will perform successfully in all UCS/Views    ;;
;;  and is compatible with Anonymous Blocks, Dynamic Blocks & XRefs.    ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.5    -    05-07-2013                                      ;;
;;----------------------------------------------------------------------;;

(defun c:cb nil (LM:RenameBlockReference   t))
(defun c:rb nil (LM:RenameBlockReference nil))

(defun LM:RenameBlockReference ( cpy / *error* abc app dbc dbx def doc dxf new old prp src tmp vrs )

   (defun *error* ( msg )
       (if (and (= 'vla-object (type dbx)) (not (vlax-object-released-p dbx)))
           (vlax-release-object dbx)
       )
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (while
       (progn
           (setvar 'errno 0)
           (setq src (car (entsel (strcat "\nSelect block reference to " (if cpy "copy & " "") "rename: "))))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (= 'ename (type src))
                   (setq dxf (entget src))
                   (cond
                       (   (/= "INSERT" (cdr (assoc 0 dxf)))
                           (princ "\nPlease select a block reference.")
                       )
                       (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 dxf)))))))
                           (princ "\nSelected block is on a locked layer.")
                       )
                   )
               )
           )
       )
   )
   (if (= 'ename (type src))
       (progn
           (setq app (vlax-get-acad-object)
                 doc (vla-get-activedocument app)
                 src (vlax-ename->vla-object src)
                 old (vlax-get-property src (if (vlax-property-available-p src 'effectivename) 'effectivename 'name))
                 tmp 0
           )
           (while (tblsearch "block" (setq def (strcat (vl-string-left-trim "*" old) "_" (itoa (setq tmp (1+ tmp)))))))
           (while
               (and (/= "" (setq new (getstring t (strcat "\nSpecify new block name <" def ">: "))))
                   (or (not (snvalid new))
                       (tblsearch "block" new)
                   )
               )
               (princ "\nBlock name invalid or already exists.")
           )
           (if (= "" new)
               (setq new def)
           )
           (setq dbx
               (vl-catch-all-apply 'vla-getinterfaceobject
                   (list app
                       (if (< (setq vrs (atoi (getvar 'acadver))) 16)
                           "objectdbx.axdbdocument"
                           (strcat "objectdbx.axdbdocument." (itoa vrs))
                       )
                   )
               )
           )
           (if (or (null dbx) (vl-catch-all-error-p dbx))
               (princ "\nUnable to interface with ObjectDBX.")
               (progn
                   (setq abc (vla-get-blocks doc)
                         dbc (vla-get-blocks dbx)
                   )
                   (vlax-invoke doc 'copyobjects (list (vla-item abc old)) dbc)
                   (if (wcmatch old "`**")
                       (vla-put-name (vla-item dbc (1- (vla-get-count dbc))) new)
                       (vla-put-name (vla-item dbc old) new)
                   )
                   (vlax-invoke dbx 'copyobjects (list (vla-item dbc new)) abc)
                   (vlax-release-object dbx)
                   (if cpy (setq src (vla-copy src)))
                   (if
                       (and
                           (vlax-property-available-p src 'isdynamicblock)
                           (= :vlax-true (vla-get-isdynamicblock src))
                       )
                       (progn
                           (setq prp (mapcar 'vla-get-value (vlax-invoke src 'getdynamicblockproperties)))
                           (vla-put-name src new)
                           (mapcar
                              '(lambda ( a b )
                                   (if (/= "ORIGIN" (strcase (vla-get-propertyname a)))
                                       (vla-put-value a b)
                                   )
                               )
                               (vlax-invoke src 'getdynamicblockproperties) prp
                           )
                       )
                       (vla-put-name src new)
                   )
                   (if (= :vlax-true (vla-get-isxref (setq def (vla-item (vla-get-blocks doc) new))))
                       (vla-reload def)
                   )
                   (if cpy (sssetfirst nil (ssadd (vlax-vla-object->ename src))))
               )
           )
       )
   )
   (princ)
)

;;----------------------------------------------------------------------;;

(vl-load-com)
(princ
   (strcat
       "\n:: CopyRenameBlock.lsp | Version 1.5 | \\U+00A9 Lee Mac "
       (menucmd "m=$(edtime,$(getvar,date),YYYY)")
       " www.lee-mac.com ::"
       "\n:: Available Commands:"
       "\n::    \"CB\"  -  Copy & Rename Block Reference."
       "\n::    \"RB\"  -  Rename Block Reference."
   )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

then i find fixblock lisp that put all block layers to block current layer

    ;   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.
   ;
   ;   Revision:
   ;   3-Dec-2003 YZ
   ;      Changed program to work from a keyword on the command line
   ;*******************************************************************************
(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
   ;*******************************************************************************

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

   ;*******************************************************************************

(defun C:FIXBLOCK () (d_FixBlock))
(princ)

So the only lisp i need is to put them all in one lisp and move the results to a new layer

Can any one help me

Thanks

Edited February 18, 2015 by prodromosm

Sign In

rename a block and move it to a new layer

Recommended Posts

Guest

hmsilva

Guest

eldon

Guest

eldon

Guest

eldon

hmsilva

Guest

hmsilva

Guest

ReMark

hmsilva

Guest

Join the conversation

Tutorials

Forums

Activity