Here is something I wrote a while ago which may help you out. I have attached the entire dvb file for your reference as well.
Hope it helps.
~Tim
frmRasterImage (code):
Option Explicit
Private Sub cmdBrowse_Click()
Dim Dia As New CommonDialog
With Dia
.DefaultExt = "*.tif"
.DialogTitle = "Select a raster image"
.Filter = "Raster Images (*.tif)" & Chr(0) & "*.tif" & Chr(0)
.ShowOpen
End With
tbFile.Text = Dia.FileName
End Sub
Private Sub cmdGenerate_Click()
frmRasterImage.Hide
Dim InsertionPoint(0 To 2) As Double
Dim ScaleFactor As Double
Dim RotationAngle As Double
Dim RA As AcadRasterImage
Dim TB As AcadBlockReference
Dim Border As String
Dim PaperSize As String
InsertionPoint(0) = 0
InsertionPoint(1) = 0
InsertionPoint(2) = 0
ScaleFactor = 1
RotationAngle = 0
On Error GoTo ERRORHANDLER
If Not cboPaper.Value = "" And Not tbFile.Value = "Path to File" Then
Select Case cboPaper.Value
Case "A Size"
Border = "TIF_A-BORDER_STD.dwg"
PaperSize = "a"
Case "B Size"
Border = "TIF_B-BORDER_STD.dwg"
PaperSize = "b"
Case "C Size"
Border = "TIF_C-BORDER_STD.dwg"
PaperSize = "c"
Case "D Size"
Border = "TIF_D-BORDER_STD.dwg"
PaperSize = "d"
End Select
'Inserts the title block specified
Set TB = ThisDrawing.ModelSpace.InsertBlock(InsertionPoint, Border, ScaleFactor, ScaleFactor, ScaleFactor, RotationAngle)
'Inserts the raster imaged specified with the dialog
Set RA = ThisDrawing.ModelSpace.AddRaster(tbFile.Text, InsertionPoint, ScaleFactor, RotationAngle)
'automatically scales the image to fit within the boundries
AutoScaleImage (PaperSize)
Else:
MsgBox "Please Complete the Form.", vbCritical, "Komline-Sanderson Engineering Corporation"
frmRasterImage.Show
Exit Sub
End If
ERRORHANDLER:
Debug.Print Err.Description
Set RA = Nothing
Set TB = Nothing
Application.UnloadDVB "\\a2fileserver\engineering\engineeringstandards\cad\lisps\rasterimage.dvb"
End Sub
Private Sub UserForm_Initialize()
cboPaper.AddItem "A Size"
cboPaper.AddItem "B Size"
cboPaper.AddItem "C Size"
cboPaper.AddItem "D Size"
End Sub
modRaster (Code):
Option Explicit
Public Sub ShowForm()
frmRasterImage.Show
End Sub
Public Function GetRasterMax(Image As AcadRasterImage) As Double()
Dim HeightWidth(0 To 1) As Double
HeightWidth(0) = Image.ImageHeight
HeightWidth(1) = Image.ImageWidth
GetRasterMax = HeightWidth
End Function
Public Sub AutoScaleImage(PaperSize As String)
Dim ae As AcadEntity
Dim RasterMax() As Double
Dim MaxHeight As Double
Dim MaxWidth As Double
Dim Zero(0 To 2) As Double
Dim ScaleFactor As Double
'it's 0,0,0
Zero(0) = 0
Zero(1) = 0
Zero(2) = 0
Select Case LCase(PaperSize)
Case "a"
MaxHeight = 10.75
MaxWidth = 8.25
Case "b"
MaxHeight = 10
MaxWidth = 16
Case "c"
MaxHeight = 16
MaxWidth = 21
Case "d"
MaxHeight = 21
MaxWidth = 33
End Select
For Each ae In ThisDrawing.ModelSpace
If TypeOf ae Is AcadRasterImage Then
RasterMax = GetRasterMax(ae)
If RasterMax(0) < MaxHeight And RasterMax(1) < MaxWidth Then
If LCase(PaperSize) = "a" Then
ScaleFactor = MaxWidth / RasterMax(1)
ae.ScaleEntity Zero, ScaleFactor
Else:
ScaleFactor = MaxHeight / RasterMax(0)
ae.ScaleEntity Zero, ScaleFactor
End If
ElseIf RasterMax(0) > MaxHeight Or RasterMax(1) > MaxWidth Then
ae.ScaleEntity Zero, 0.1
RasterMax = GetRasterMax(ae)
If LCase(PaperSize) = "a" Then
ScaleFactor = MaxWidth / RasterMax(1)
ae.ScaleEntity Zero, ScaleFactor
Else:
ScaleFactor = MaxHeight / RasterMax(0)
ae.ScaleEntity Zero, ScaleFactor
End If
End If
End If
Next
End Sub