Function GetBlockByRefName(BlkName As String) As AcadBlockReference
 
 
 
	'****************************************
 
	'*** Code from VisibleVisual.com ********
 
	'****************************************
 
 
 
	On Error GoTo ErrorHandler
 
	Dim SS As AcadSelectionSet
 
	'Clear the selection Set
 
	Set SS = ThisDrawing.SelectionSets.Item("SS")
 
	SS.Clear
 
	If Err Then
 
	Err.Clear
 
	Set SS = ThisDrawing.SelectionSets.Add("SS")
 
	End If
 
	'Select the blocks named BlkName
 
	Dim FType(0) As Integer, FData(0)
 
	FType(0) = 0: FData(0) = "INSERT"
 
	FType(1) = 2: FData(1) = BlkName
 
	SS.Select acSelectionSetAll, , , FType, FData
 
	'Now you've got a selection set of all blocks named "BlkName"
 
	If SS.Count = 0 Then Exit Function 'Block is unreferenced, so exit
 
	'Return the first block in the SS
 
	Set GetBlockByRefName = SS.Item(0)
 
 
 
	SS.Delete
 
	Set BlkRef = Nothing
 
	Set SS = Nothing
 
	Exit Function
 
	ErrorHandler:
 
	MsgBox Err.Description
 
	End Function