here's my secret insert routine...enjoy
Public Function InsertBlkRef(ByVal sBlkName As String, _
Optional ByVal bExplode As Boolean = True, _
Optional ByVal iSpace As Integer = 0, _
Optional ByVal dScale As Double = 1#, _
Optional ByVal vInsPt As Variant, _
Optional ByVal dRot As Double = 0#, _
Optional ByVal bLastObj As Boolean = False) As AcadBlockReference
'------------------------------------------------------------------------------
'InsertBlkRef: Defaults are:
' EXPLODED
' MODELSPACE
' 1:1 SCALE
' 0,0 INSERT POINT
' 0 ROTATION
' True RETURN LAST EXPLODED ITEM (use after explode of block
' which reveals another block)
'Arguments: sBlkName = path and/or filename (i.e. "someblock.dwg")
' bExplode = insert exploded TRUE or not explode FALSE
' iSpace(OPT) = 0 for paperspace and 1 (default) is modelspace
' dScale(OPT) = scale, the same for X and Y
' vInsPt(OPT) = insertion point, zero-zero if none given
' dRot(OPT) = rotation in degrees (converted to radians
' within function), defaults to zero if not given
'Returns: Block reference (if it is the only item in the block)
'------------------------------------------------------------------------------
Dim acBlkRef As AcadBlockReference
Dim dInsPt(0 To 2) As Double
Dim acBlkEnts
'''''''''''''''''''''''''''''''''''''''
On Error GoTo ErrHandler
'--------------------------------------------------------------------------
'Set insertion point. Set to 0,0 if none given
'--------------------------------------------------------------------------
If IsMissing(vInsPt) Then
dInsPt(0) = 0#: dInsPt(1) = 0#: dInsPt(2) = 0#
Else
dInsPt(0) = vInsPt(0)
dInsPt(1) = vInsPt(1)
dInsPt(2) = vInsPt(2)
End If
dRot = DegreesToRadians(dRot)
'--------------------------------------------------------------------------
'Check if need to add .dwg for pathed files
'--------------------------------------------------------------------------
If InStr(sBlkName, "\") And Not LCase(Right$(sBlkName, 4)) = ".dwg" Then
sBlkName = sBlkName & ".dwg"
End If
'--------------------------------------------------------------------------
'Set space to insert into. Then insert drawing
'--------------------------------------------------------------------------
If iSpace = 1 Then
Set acBlkRef = ThisDrawing.PaperSpace.InsertBlock(dInsPt, _
sBlkName, dScale, dScale, dScale, dRot)
Else
Set acBlkRef = ThisDrawing.ModelSpace.InsertBlock(dInsPt, _
sBlkName, dScale, dScale, dScale, dRot)
End If
'--------------------------------------------------------------------------
'Make sure block is inserted and explode if required
'--------------------------------------------------------------------------
If Not acBlkRef Is Nothing Then
If bExplode Then
acBlkEnts = acBlkRef.Explode
acBlkRef.Delete 'Gets rid of original copy, leaves exploded one
If bLastObj Then
Set InsertBlkRef = EntLast 'last modelspace entity
End If
Set acBlkRef = Nothing
Else
Set InsertBlkRef = acBlkRef
End If
End If
ExitHere:
Exit Function
ErrHandler:
Debug.Print vbObjectError + 514, "PP_ACAD Error", _
"Function 'InsertBlkRef' Failed"
Err.Clear
End Function
"Everybody is ignorant, only on different subjects." — Will Rogers
