|
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.
Show/Hidden vbnet code
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
oBkRef.Delete
'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"
 
Attachments:
| File | Description | File size | Downloads |
|---|
 Replace Block | Replace a Block by another Block | 7 Kb | 280 |
|
Comments
Where the new block have different tag names, but similar such as "DWGNUMBER" instead of "DRGNo".
It will also have to read the value of the old tag and re-enter it in the new block.
This is not so simple as you need to
1- Find the block
2- Read the block insert, scale
3- Read attribute value
4- Delete old block
5- purge old block as (yes same block name and Atttribute definition won't get re-define)
6- Insert new block using insert point and scale
7- re-enter attribute data
Loop on both model space and all layout space.
Replaceblock "blockname1", "blockname2"
End Sub
Function Replaceblock(By Val Block2replace As String, ByVal Block2add As String)
Dim blockobj As AcadBlockRefere nce
For Each ent In ThisDrawing.Blocks(Block2re place)
ent.Delete
Next
Set blockRefObj = ThisDrawing.Blocks(Block2re place).insertblock(Thi sDrawing.Blocks(Block2ad d).Origin, Block2add, 1, 1, 1, 0)
blockRefObj.Explode
blockRefObj.Delete
End Function
RSS feed for comments to this post.