Author Topic: Inserting a Raster Image  (Read 1877 times)

0 Members and 1 Guest are viewing this topic.

ML

  • Guest
Inserting a Raster Image
« on: November 02, 2007, 10:08:41 AM »

Hi, I am attempting to Insert a Raster File into my drawing.
I do not see an Insert Method but can someone steer me in the right direction and tell me if I am on the right track here?

Thank you
Mark

Code: [Select]
Dim RastImg As AcadRasterImage
Dim Imgpth As String
Dim Imgnme As String

Set RastImg = ThisDrawing.ModelSpace.AddRaster(Imgnme, "0, 0", 2, 0)

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
Re: Inserting a Raster Image
« Reply #1 on: November 02, 2007, 10:21:52 AM »
BRB, I have lots of Rastis code
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
Re: Inserting a Raster Image
« Reply #2 on: November 02, 2007, 10:30:55 AM »
This is from the help file, as all my code was doing really weird things, and I didn't want to confuse the issue

Code: [Select]
Sub Example_AddRaster()
    ' This example adds a raster image in model space.
   
    ' This example uses a file named "raster.jpg."
    ' You should change this example to use
    ' a raster file on your computer.
   
    Dim insertionPoint(0 To 2) As Double
    Dim scalefactor As Double
    Dim rotationAngle As Double
    Dim imageName As String
    Dim rasterObj As AcadRasterImage
    imageName = "C:\raster.jpg"
    insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0#
    scalefactor = 1#
    rotationAngle = 0
   
    On Error Resume Next
    ' Creates a raster image in model space
    Set rasterObj = ThisDrawing.ModelSpace.AddRaster(imageName, insertionPoint, scalefactor, rotationAngle)
   
    If Err.Description = "File error" Then
        MsgBox imageName & " could not be found."
        Exit Sub
    End If
    ZoomExtents
End Sub
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • Guest
Re: Inserting a Raster Image
« Reply #3 on: November 02, 2007, 11:15:59 AM »

Thanks CM

It looks like I found that same example, or something similar in The VBE Help Files

I can not get that error handler to work though?

Mark

M-dub

  • Guest
Re: Inserting a Raster Image
« Reply #4 on: November 02, 2007, 11:20:08 AM »

ML

  • Guest
Re: Inserting a Raster Image
« Reply #5 on: November 02, 2007, 11:28:56 AM »

Hey M
First off; Keith is a great programmer
So hats off to Keith Blackie :)

The other cool thing was that he brought up THe OpenFileDialog which I have just started learning and it is very cool.

I only read through the first page but it was very good, thank you

M-dub

  • Guest
Re: Inserting a Raster Image
« Reply #6 on: November 02, 2007, 11:31:01 AM »
No Problem!

I still use that utility that Keith wrote.  Very schweet indeed!  :)

ML

  • Guest
Re: Inserting a Raster Image
« Reply #7 on: November 02, 2007, 11:33:35 AM »

That's cool

I don't need an executable as we are doing something very specific however the code was good to look over and to reference back to.

Keith has written a few things for me in the past that I still probably will not understand simply because he is so much more far advanced then I am.

Still, that will never stop me from getting to where I need to be :)

Keith actually once described something to me called the circle of knowledge; it was very interesting.

Mark


ML

  • Guest
Re: Inserting a Raster Image
« Reply #8 on: November 02, 2007, 11:39:38 AM »

Hey CM

Here is how I am handling the error and it works just fine

Mark

Code: [Select]
On Error GoTo Errorhandler
Set RastImg = ThisDrawing.ModelSpace.AddRaster(Imgname, InsertPnt, Scalefactor, RotAngle)
   
Errorhandler:
   If Err.Description = "File access error" Then
        MsgBox "Imagefile" & " could not be found."
        Exit Sub
    End If

TR

  • Guest
Re: Inserting a Raster Image
« Reply #9 on: November 02, 2007, 11:50:07 AM »
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):
Code: [Select]
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):
Code: [Select]
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

ML

  • Guest
Re: Inserting a Raster Image
« Reply #10 on: November 02, 2007, 11:56:15 AM »

THat is very nice Tim!

Thank you!

ML

  • Guest
Re: Inserting a Raster Image
« Reply #11 on: November 02, 2007, 01:04:03 PM »

Tim
I am looking at other code that someone else has used the openfiledialog with however, I am not sure which variables are grabbing the file name and path? Any idea? Also, any suggestions are welcome

Thank you

Mark

Code: [Select]
Public Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Sub ShowFileOpenDialog(ByRef FileList As Collection)
    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long
    Dim FileDir As String
    Dim FilePos As Long
    Dim PrevFilePos As Long

    With OpenFile
        .lStructSize = Len(OpenFile)
        .hwndOwner = 0
        .hInstance = 0
        .lpstrFilter = "Image File (*.tif)" + Chr(0) + "*.tif"
        .nFilterIndex = 1
        .lpstrFile = String(4096, 0)
        .nMaxFile = Len(.lpstrFile) - 1
        .lpstrFileTitle = .lpstrFile
        .nMaxFileTitle = .nMaxFile
        .lpstrInitialDir = ThisDrawing.Path
        .lpstrTitle = "Select Image File"
        .flags = OFN_HIDEREADONLY + _
            OFN_PATHMUSTEXIST + _
            OFN_FILEMUSTEXIST + _
            OFN_ALLOWMULTISELECT + _
            OFN_EXPLORER
        lReturn = GetOpenFileName(OpenFile)
        If lReturn <> 0 Then
            FilePos = InStr(1, .lpstrFile, Chr(0))
            If Mid(.lpstrFile, FilePos + 1, 1) = Chr(0) Then
                FileList.Add .lpstrFile
            Else
                FileDir = Mid(.lpstrFile, 1, FilePos - 1)
                Do While True
                    PrevFilePos = FilePos
                    FilePos = InStr(PrevFilePos + 1, .lpstrFile, Chr(0))
                    If FilePos - PrevFilePos > 1 Then
                        FileList.Add FileDir + "\" + _
                            Mid(.lpstrFile, PrevFilePos + 1, _
                                FilePos - PrevFilePos - 1)
                    Else
                        Exit Do
                    End If
                Loop
            End If
        End If
    End With
End Sub


Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
    "GetOpenFileNameA" (pOpenFileName As OPENFILENAME) As Long



Function SelectFiles() As String
    Dim FileList As New Collection
    Dim I As Long
    Dim s As String

    ShowFileOpenDialog FileList
    With FileList
        If .Count > 0 Then
            s = "The following files were selected:" + vbCrLf
            For I = 1 To .Count
               SelectFiles = .Item(I)
            Next
        Else
             Exit Function
            'MsgBox "No files were selected!"
        End If
    End With
End Function

TR

  • Guest
Re: Inserting a Raster Image
« Reply #12 on: November 02, 2007, 01:11:48 PM »
Why don't you just use the class by Frank O. inside the dvb file I posted?

Getting the filename was as easy as:
Code: [Select]
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

ML

  • Guest
Re: Inserting a Raster Image
« Reply #13 on: November 02, 2007, 01:17:28 PM »
I don't quite understand where to put it
Also, I don't see where you grabbing the path and filename from??

Mark

ML

  • Guest
Re: Inserting a Raster Image
« Reply #14 on: November 02, 2007, 01:18:18 PM »

And you are using a form.
I see you got the filename from the Textbox

Please correct me if I am wrong?

Thank you

Mark