Trying to rename a block before Reinserting in VBA?

[muck]

In the following code I am trying to rename a block to allow me to reinsert it form a file

but that does not work becuse I get error when I try to insert it.

 

The code is as follows:

Dim DrawingNames()

Dim DrawingList As New ClassVBDwgFileList

Dim startPnt As Variant

Dim prompt1 As String

Dim InsertBlockName As String

 

Private Sub CommandButton1_Click()

prompt1 = vbCrLf & "Enter the placement point for block: "

Me.hide

startPnt = ThisDrawing.Utility.GetPoint(, prompt1)

Me.Show

End Sub

Public Sub InstBlock()

Dim startPnt As Variant

Dim prompt1 As String

prompt1 = vbCrLf & "Enter the placement point for block: "

Me.hide

startPnt = ThisDrawing.Utility.GetPoint(, prompt1)

ThisDrawing.ModelSpace.InsertBlock startPnt, "C:\BlockInsert.Dwg", 1#, 1#, 1#, 0

ThisDrawing.Activate

Me.Show

End Sub

 

Private Sub CommandButton2_Click()

InsertBlockName = "BlockInsert.Dwg"

RenameBlock

MsgBox InsertBlockName

'ThisDrawing.ModelSpace.InsertBlock startPnt, InsertBlockName, 1#, 1#, 1#, 0

ThisDrawing.ModelSpace.InsertBlock startPnt, "C:\BlockInsert.Dwg", 1#, 1#, 1#, 0

ThisDrawing.Activate

Me.hide

End Sub

 

Private Sub CommandButton3_Click()

Me.hide

Dim zcount As Integer

DrawingList.VBDwgFileList

AutoCAD.Documents.Close

For zcount = 0 To DrawingList.filecount - 1

FileName = DrawingList.VBDwgFileNames(zcount)

If FileName "" Then AutoCAD.Documents.Open (FileName)

If Application.Documents.Count = 0 Then

MsgBox "Empty AutoCAD Editor"

Exit Sub

End If

InsertBlockName = "BlockInsert.Dwg"

RenameBlock

MsgBox "startpnt"

ThisDrawing.ModelSpace.InsertBlock startPnt, InsertBlockName, 1#, 1#, 1#, 0

ThisDrawing.Activate

Debug.Print FileName

ThisDrawing.Save 'Save the drawing

ThisDrawing.Close

Debug.Print zcount

If zcount = DrawingList.filecount - 1 Then Exit Sub

Next

Me.Show

End Sub

 

Public Sub RenameBlock()

Dim strName As String

Dim objBlock As AcadBlock

On Error Resume Next ' handle exceptions inline

'strName = InputBox("Original Block name: ")

strName = "BlockInsert"

If "" = strName Then Exit Sub ' exit if no old name

Set objBlock = ThisDrawing.Blocks.Item(strName)

If objBlock Is Nothing Then ' exit if not found

MsgBox "Block '" & strName & "' not found"

Exit Sub

End If

'strName = InputBox("New Block name: ")

strName = InsertBlockName + "-6"

If "" = strName Then Exit Sub ' exit if no new name

objBlock.Name = strName ' try and change name

If Err Then ' check if it worked

MsgBox "Unable to rename block: " & vbCr & Err.Description

Else

MsgBox "Block renamed to '" & strName & "'"

End If

'InsertBlockName = strName

End Sub