TheSwamp
Code Red => VB(A) => Topic started by: ML 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
Dim RastImg As AcadRasterImage
Dim Imgpth As String
Dim Imgnme As String
Set RastImg = ThisDrawing.ModelSpace.AddRaster(Imgnme, "0, 0", 2, 0)
-
BRB, I have lots of Rastis code
-
This is from the help file, as all my code was doing really weird things, and I didn't want to confuse the issue
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
-
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
-
http://www.theswamp.org/index.php?topic=1836.0
Have a read here. :)
-
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
-
No Problem!
I still use that utility that Keith wrote. Very schweet indeed! :)
-
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
-
Hey CM
Here is how I am handling the error and it works just fine
Mark
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
-
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
-
THat is very nice Tim!
Thank you!
-
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
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
-
Why don't you just use the class by Frank O. inside the dvb file I posted?
Getting the filename was as easy as:
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
-
I don't quite understand where to put it
Also, I don't see where you grabbing the path and filename from??
Mark
-
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