Replacing all blocks on a layer with another block

[Organic]

This is probably a stupid question, although I can't remember how to do the following (fairly sure it is possible):

 

I was sent a drawing where the same block (block A) resides on multiple layers. I isolate one of the layers and want to change all the blocks (A) on this layer to a different block, block B. However, I cannot edit the block definition as block A must remain the same on the other layers.

 

So how do I replace/change one block to another block when I have the blocks I want to change selected?

[Tyke]

Freeze all the layers except the one with your blocks on. Place a sample of your new block on the layer and then use the Express Tools function Replace Blocks. Don't forget to delete your sample block :wink:

[Organic]

 

I actually tried that before and couldn't get it to work as needed.

 

I tried it again, this time freezing all the other layers (rather than just isolating my desired layer). The problem is it converts all instances of the block in the drawing to the new block (including those on the frozen layers which I want to retain as their original/old block definition).

[Tyke]

You can do it with LISP and VBA, have you had a look on Lee Mac's site to see what he has?

[Tyke]

Here's some VBA code that will do what you want:

 

Option Explicit

' Tyke 13.07.2011

Sub SwapBlocksOnLayer()
   
   Dim booPickedOrg    As Boolean
   Dim booPickedRep    As Boolean
   Dim oEnt            As AcadEntity
   Dim varPos          As Variant
   Dim brefOrgBlock    As AcadBlockReference
   Dim brefRepBlock    As AcadBlockReference
   Dim strOrgBlockName As String
   Dim strRepBlockName As String
   Dim strBlockLayer   As String
   Dim lngBlockCount   As Long
   Dim colSelSets      As AcadSelectionSets
   Dim objSelSet       As AcadSelectionSet
   Dim ssBlocks        As AcadSelectionSet
   Dim strSSName       As String
   Dim vCodeB          As Variant
   Dim vDataB          As Variant
   Dim iCode()         As Integer
   Dim vData()         As Variant
   
START:
   lngBlockCount = 0
   ' select block to be replaced
   booPickedOrg = False                       ' nothing selected
   
   ' loop until something is selected
   Do While Not booPickedOrg
       ThisDrawing.Utility.GetEntity oEnt, varPos, "Select the block to be replaced: "
       If oEnt Is Nothing Then
          booPickedOrg = False
       Else                                    ' if something has been selected
           If oEnt.ObjectName = "AcDbBlockReference" Then
               strOrgBlockName = oEnt.Name     ' original block name
               strBlockLayer = oEnt.Layer      ' layer name
               Exit Do                         ' quit the loop
           End If
       End If
   Loop
      
   ' select replacement block
   booPickedRep = False                       ' nothing selected
   
   ' loop until something is selected
   Do While Not booPickedRep
       ThisDrawing.Utility.GetEntity oEnt, varPos, "Select the replacement block: "
       If oEnt Is Nothing Then
          booPickedRep = False
       Else                                    ' if something has been selected
           If oEnt.ObjectName = "AcDbBlockReference" Then
               strRepBlockName = oEnt.Name     ' replacement block name
               booPickedRep = True
               Exit Do                         ' quit the loop
           End If
       End If
   Loop
   
   ' check if they are the same block
   If strOrgBlockName = strRepBlockName Then
       MsgBox "You picked the same block twice, try again", vbOKOnly
       GoTo START
   End If
   
   On Error Resume Next
   
   Err.Clear
   
   Set colSelSets = ThisDrawing.SelectionSets
   
   ' ####################### create the selset for the blocks #############################
   
   strSSName = "ssBlocks"
   
   ReDim iCode(4)
   ReDim vData(4)
   
   For Each objSelSet In colSelSets
       If objSelSet.Name = strSSName Then
           colSelSets.Item(strSSName).Delete
           Exit For
       End If
   Next
   
   Set ssBlocks = colSelSets.Add(strSSName)
   
   ' set filter values
   iCode(0) = -4: vData(0) = "<and"            ' filter = and start
   iCode(1) = 0:  vData(1) = "insert"          ' text entities
   iCode(2) = 2:  vData(2) = strOrgBlockName   ' block name
   iCode(3) = 8:  vData(3) = strBlockLayer     ' layer name
   iCode(4) = -4: vData(4) = "and>"            ' filter = and end

   vCodeB = iCode
   vDataB = vData

   ' populate selection set with just the text on the layer
   ssBlocks.Select acSelectionSetAll, , , vCodeB, vDataB
   
   ' if selset is empty exit sub
   If ssBlocks.Count = 0 Then Exit Sub
   
   ' ################## end of create the selset for the blocks #############################
   
   ' swap the blocks
   For Each brefOrgBlock In ssBlocks
       ' swap the block
       varPos = brefOrgBlock.InsertionPoint
       
       Set brefRepBlock = ThisDrawing.ModelSpace.InsertBlock(varPos, _
       strRepBlockName, 1#, 1#, 1#, 0)
       
       ' set blocks properties
       brefRepBlock.Layer = strBlockLayer
       
       ' delete existing block
       brefOrgBlock.Delete
       
       ' increment counter
       lngBlockCount = lngBlockCount + 1
       
   Next brefOrgBlock
   
   ' update screen
   Application.ActiveDocument.Regen acAllViewports
   
   MsgBox CStr(lngBlockCount) & " blocks swapped (" & strOrgBlockName & " for " & strRepBlockName & " on layer " & strBlockLayer & ")", vbOKOnly
   
   
End Sub

 

It works fine for me.

[Lee Mac]

This code will use the shortcut of renaming the selected references so that they reference a different block definition, but, although there is less legwork, there are some assumptions and drawbacks to this method:

 

 

• Assumes replacement block definition is present in the drawing
  

 

• Will not work with attributed blocks (since attributes are 'separate' from the block definition).
  

(defun c:brsel ( / b1 ss ) (vl-load-com)
 (if
   (and
     (princ "\nSelect Block to be Inserted...")
     (setq b1 (ssget "_+.:E:S" '((0 . "INSERT") (2 . "~`**") (66 . 0))))
     (setq b1 (cdr (assoc 2 (entget (ssname b1 0)))))
     (princ "\nSelect Blocks to be Replaced...")
     (ssget "_:L" (list '(0 . "INSERT") (cons 2 (strcat "~" b1)) '(66 . 0)))
   )
   (progn
     (vlax-for obj (setq ss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
       (vla-put-name obj b1)
     )
     (vla-delete ss)
   )
 )
 (princ)
)