See the top rated post in this thread. Click here

Results 1 to 3 of 3

Thread: Lisp to rename multiple blocks within a drawing

  1. #1
    Member
    Join Date
    2018-10
    Posts
    5
    Login to Give a bone
    0

    Default Lisp to rename multiple blocks within a drawing

    I found some coding on another site that is supposed to change one block name to another block name, and it appears that it will do many block names all at once based on a list. I can't get it to work and my drawings have around 100 blocks on them each which need to be renamed, plus I have hundreds of drawings that would need to be batch renamed so I don't have to open each file individually.

    The end goal is to replace Block A with Block B where the difference between the blocks is attributes, colors and names, but done on many drawings in a folder with many blocks per drawing.


    My idea is to run a batch file that will rename all of the blocks from old name to new name, then run a batch file to replace Block A with Block B using a list of blocks within a script. I have a master file containing the blocks that I want the script to look for, then replace them all with the new blocks. I don't know if there is an easier way to do this because my current drawings have blocks named Block A to Block Z, and the new blocks are named Block 1 to Block 26.


    This is the rename that I found:


    Code:
     
    ;;function to rename a block.
    ;;if old block exists, and new block doesn't exist, the old block is simply renamed.
    ;;if old block exists, it does nothing
    ;;if old block it alerts 'Block not found'.
    (defun renblock (ol nl / ss i ent )
     (cond ((and (tblsearch "block" ol) (not (tblsearch "block" nl))) 
     (command "._rename" "block" ol nl)
    )
    ((and (tblsearch "block" ol)(tblsearch "block" nl))
      (setq ss (ssget "x" (list (cons 2 ol))))
      (setq i -1)
       (repeat (sslength ss)
          (setq ent (entget (ssname ss (setq i (1+ i))))
         ent (subst (cons 2 nl) (cons 2 (cdr (assoc 2 ent))) ent)
          )    
          (entmod ent)
              )
    )
    ((not (tblsearch "block" ol))
      (prompt (strcat "\nBlock " ol " not found. "))
           )
     )
     (princ)
    )
    ;;example
    (defun c:test ()
     (renblock "old block1" "Renamed1")
     (renblock "old block2" "Renamed2")
     (renblock "old block3" "Renamed3")
    )
    Last edited by rkmcswain; 2018-10-12 at 05:55 PM. Reason: added [CODE] tags

  2. #2
    Administrator BlackBox's Avatar
    Join Date
    2009-11
    Posts
    5,545
    Login to Give a bone
    0

    Default Re: Lisp to rename multiple blocks within a drawing

    I happened to have something similar open when I saw this; it doesn't handle a list of Old-->New Block names, but it should handle an entire folder of drawings pretty quickly as a starting point.

    You're welcome to modify the code as you like.

    [Edit] - Replaced (not (vla-get-isxref x)) with (= :vlax-false (vla-get-isxref x))

    Code:
    (vl-load-com)
    
    (defun c:BatchBlockRename (/ *error* acApp dwgName oShell oFolder path
                               dwgs oldName newName dbxDoc nomutt dwgName i
                              )
    
      (princ "\rBATCHBLOCKRENAME ")
    
      (defun *error* (msg)
        (if nomutt
          (setvar 'nomutt nomutt)
        )
        (if oShell
          (vlax-release-object oShell)
        )
        (if dbxDoc
          (vlax-release-object dbxDoc)
        )
        (cond ((not msg))                                                   ; Normal exit
              ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
              ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
        )
        (princ)
      )
    
      (if
        (and
          (setq acApp (vlax-get-acad-object))
          (setq dwgName (getvar 'dwgname))
          (setq oShell (vla-getinterfaceobject
                         acApp
                         "Shell.Application"
                       )
          )
          (setq oFolder (vlax-invoke
                          oShell
                          'BrowseForFolder
                          (vla-get-hwnd acApp)
                          "Select folder to process:"
                          0
                          (+ 1 64 256)
                        )
          )
          (setq path (vlax-get-property
                       (vlax-get-property oFolder 'Self)
                       'Path
                     )
          )
          (setq dwgs (vl-directory-files path "*.dwg" 1))
          (setq oldName
                 (getstring
                   T
                   "\nEnter old Block name to rename (case-sensitive): "
                 )
          )
          (setq
            newName (getstring T
                               "\nEnter new Block name (case-sensitive): "
                    )
          )
          (princ "\nWorking, please wait...")
          (princ)
          (setq dbxDoc (vla-getinterfaceobject
                         acApp
                         (strcat "ObjectDBX.AxDbDocument."
                                 (substr (getvar 'acadver) 1 2)
                         )
                       )
          )
          (setq nomutt (getvar 'nomutt))
          (setvar 'nomutt 1)
        )
         (progn
           (foreach dwg dwgs
             (if (/= dwg dwgName)
               (progn
                 (vl-catch-all-apply
                   'vla-open
                   (list dbxDoc (setq dwgName (strcat path "\\" dwg)))
                 )
                 (setq i 0)
                 (vlax-for x (vla-get-blocks dbxDoc)
                   (if
                     (and
                       (= (vla-get-name x) oldName)
                       (= :vlax-false (vla-get-isxref x))
                     )
                      (if
                        (not
                          (vl-catch-all-error-p
                            (vl-catch-all-apply
                              'vla-put-name
                              (list x newName)
                            )
                          )
                        )
                         (setq i (1+ i))
                      )
                   )
                 )
                 (if (< 0 i)
                   (progn
                     (vla-saveas dbxDoc dwgName)
                     (setvar 'nomutt 0)
                     (prompt
                       (strcat "\n >> " dwg " >> Block \"" oldName
                               "\" renamed as \"" newName "\" "
                              )
                     )
                     (setvar 'nomutt 1)
                   )
                   (progn
                     (setvar 'nomutt 0)
                     (prompt
                       (strcat "\n ** " dwg " >> Block \"" oldName
                               "\" NOT found in drawing ** "
                              )
                     )
                     (setvar 'nomutt 1)
                   )
                 )
               )
             )
           )
           (setvar 'nomutt 0)
           (prompt "\nDone. \n")
           (*error* nil)
         )
         (cond
           (newName
            (*error*
              "Unable to create \"ObjectDBX.AxDbDocument\" Object"
            )
           )
           (path (*error* "No drawings found"))
           (oShell (*error* nil))
           (dwgName
            (*error* "Unable to create \"Shell.Application\" Object")
           )
           ((*error*
              "Unable to create \"AcadApplication Object\" Object"
            )
           )
         )
      )
    )
    Last edited by BlackBox; 2018-10-12 at 06:47 PM.
    "How we think determines what we do, and what we do determines what we get."

    Sincpac C3D ~ Autodesk Exchange Apps

    Computer Specs:
    Dell Precision 3630, Core i9-9900K 5.0GHz, 128GB RAM, Samsung 970 Pro M.2, 8GB NVIDIA Quadro P4000

  3. #3
    Member
    Join Date
    2018-10
    Posts
    5
    Login to Give a bone
    1

    Default Re: Lisp to rename multiple blocks within a drawing

    Thanks for the coding. I've been reading through it and I can see this is way above my level. I'll keep working with it to try and understand it because if I can understand what you've done here, then I should learn a lot about how to code. I really appreciate your help with this.

Similar Threads

  1. lisp to trim the line inside multiple blocks
    By ossa.omar675029 in forum AutoLISP
    Replies: 7
    Last Post: 2014-07-15, 06:07 PM
  2. Rename multiple blocks
    By knutsen in forum AutoLISP
    Replies: 4
    Last Post: 2012-09-06, 07:48 AM
  3. how to insert multiple blocks into a drawing
    By flash5238 in forum AutoLISP
    Replies: 10
    Last Post: 2011-05-02, 04:38 PM
  4. Lisp to print multiple title blocks in a drawing
    By leo_munters in forum AutoLISP
    Replies: 5
    Last Post: 2010-07-08, 07:13 AM
  5. Lisp for scaling multiple blocks (symbol)
    By Tolgak in forum AutoLISP
    Replies: 3
    Last Post: 2004-12-09, 08:37 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •