purge block name or reference help

I'm seeking advice in purging block names or how to restructure insert block
routine so that when it runs more than once without a purge the block
doesn't gets created again on insertion. All other block insertion routines
I've created use a BlockRef As AcadBlockReference to a location on my hard
drive. These work fine.

This is one of the first routines I've done that creates the block inside
the routine. I thought this would make the routine more stable but not
finding a clear answer on how to purge a block on search of the newsgroups I
thought post .

Thanks, Have a great day.
JohnCoon

'create block name
Dim BlockName As String
BlockName = "Leachfieldrun"
Dim LayerName As String
LayerName = "C-SEWER-UNDR"

Dim ptOrigin(2) As Double
ptOrigin(0) = 0#: ptOrigin(1) = 0#: ptOrigin(2) = 0#

Dim Block As AcadBlock
Set Block = ThisDrawing.Blocks.Add(ptOrigin, BlockName)

Dim halfwith As Double
halfwith = TextBox7 / 2 ' 25'
Dim Offsetdist As Double
Offsetdist = TextBox8 '30'

Dim pt101(2) As Double
pt101(0) = 0#: pt101(1) = -halfwith: pt101(2) = 0#'
pt102(0) = 0#: pt102(1) = halfwith: pt102(2) = 0#
Dim pt103(2) As Double
pt103(0) = TextBox6: pt103(1) = halfwith: pt103(2) = 0#
Dim pt104(2) As Double
pt104(0) = TextBox6: pt104(1) = -halfwith: pt104(2) = 0#

' Add the lines to the block's definition
Block.AddLine pt101, pt102
Block.AddLine pt102, pt103
Block.AddLine pt103, pt104
Block.AddLine pt104, pt101

Set BlockRef = ThisDrawing.ModelSpace.InsertBlock(newpt2001,
"Leachfieldrun", 1#, 1#, 1#, dblRot)
Set BlockRef = ThisDrawing.ModelSpace.InsertBlock(newpt2002,
"Leachfieldrun", 1#, 1#, 1#, dblRot)

 

Hi John,
Purge is not what you want since you can't purge a block when there are
references to it in the drawing. What you want to do is check for it's
existence and create it if it's not in the database. Note that I modified
some of your code where it references textboxes so i could test it without a
form.

Function make_Leachfieldrun()
'create block name
Dim BlockName As String
BlockName = "Leachfieldrun"
Dim LayerName As String
LayerName = "C-SEWER-UNDR"

Dim ptOrigin(2) As Double
ptOrigin(0) = 0#: ptOrigin(1) = 0#: ptOrigin(2) = 0#

Dim Block As AcadBlock
Set Block = ThisDrawing.Blocks.Add(ptOrigin, BlockName)

Dim halfwith As Double
halfwith = 25 / 2 ' 25'
Dim Offsetdist As Double
Offsetdist = 30 '30'

Dim pt101(2) As Double
pt101(0) = 0#: pt101(1) = -halfwith: pt101(2) = 0# '
Dim pt102(2) As Double
pt102(0) = 0#: pt102(1) = halfwith: pt102(2) = 0#
Dim pt103(2) As Double
pt103(0) = 15: pt103(1) = halfwith: pt103(2) = 0#
Dim pt104(2) As Double
pt104(0) = 15: pt104(1) = -halfwith: pt104(2) = 0#

' Add the lines to the block's definition
Block.AddLine pt101, pt102
Block.AddLine pt102, pt103
Block.AddLine pt103, pt104
Block.AddLine pt104, pt101
End Function

Sub insert_Leachfield()
Dim BlockRef As AcadBlockReference
Dim BlockDef As AcadBlock
Dim newpt2001(2) As Double, newpt2002(2) As Double

newpt2001(0) = 100#: newpt2001(1) = 100#
newpt2002(0) = 200#: newpt2002(1) = 100#
On Error Resume Next 'catch the error if block not found
Set BlockDef = ThisDrawing.Blocks.Item("Leachfieldrun")
If BlockDef Is Nothing Then make_Leachfieldrun 'not found so create it

On Error GoTo 0
Set BlockRef = ThisDrawing.ModelSpace.InsertBlock(newpt2001,
"Leachfieldrun", 1#, 1#, 1#, 0)
Set BlockRef = ThisDrawing.ModelSpace.InsertBlock(newpt2002,
"Leachfieldrun", 1#, 1#, 1#, 0)

End Sub

 

Hi Jeff,

Thanks so much for your comments. I was banging my head on this. This is
exactly what I was looking to do. I didn't notice it on several other
routines
because they were placing the same sized block just in deferent locations.
This sample routine was dynamic in the sizing of the block and that's when I
noticed it.

Thanks as always.

John Coon