22 | 02 | 2017

Replace Block

The code below can be used to look for a block, delete it and then replace it at the same insert points with another block.

Function Replaceblock(ByVal Block2replace As String, ByVal Block2add As String)

'*** Code from VisibleVisual.com ********

Dim ent As AcadEntity
Dim oBkRef As AcadBlockReference
Dim Insertpoints As Variant

Dim v As Variant
Dim I As Long

'First we go over every object in the modelspace
For Each ent In ThisDrawing.ModelSpace

'Check if the object is a block
If ent.ObjectName = "AcDbBlockReference" Then
Set oBkRef = ent

'If the object is a block then check if its the block we are looking for
If oBkRef.EffectiveName = Block2replace Then

'get the blocks insertion points
Insertpoints = oBkRef.insertionpoint

'delete the old instance

'insert the new block at the same location
InsertBlock Block2add, Insertpoints, 0

End If
End If

'Next object
Next ent

End Function

Function InsertBlock(ByVal blockname As String, ByVal insertionpoint As Variant, ByVal rotation As Double)
'This function inserts a new block

Dim blockobj As AcadBlockReference
Dim insertionPnt As Variant
Dim prompt1 As String

'set rotation Angle
rotateAngle = rotation
rotateAngle = rotation * 3.141592 / 180#

ThisDrawing.ActiveSpace = acModelSpace

Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionpoint, blockname, 1#, 1#, 1#, rotateAngle)

End Function

Sub TestReplaceBlock()
'Test the functions
Replaceblock "Blockname1", "Blockname2"

End Sub

The code will search all blocks in modelspace, if the name is the same as the block that you are looking for then it will get the insert points and insert a new block.

Below an example of the result, left the original block called 'blockname1", right the replaced block called "blockname2"

blockname1  blockname2


Sign up now and upload your code to the website.

Help us to continue.....
Articles View Hits
Latest Articles