File associations are rather easily done...
Open any folder... go to "Tools -> Folder Options"
select the FileTypes Tab
Find the extensions you want opened in AutoCAD automatically when double clicking on them
highlight the extension, select the Change button
in the resulting window browse to the InsertImage executable.. make sure you have the InsertImage executable where it's final location will be otherwise if you move it the file association may fail.
Select Ok, and close the window(s)
All done....
Now for the code.....commented extensively for your ease of understanding
'declare API function to show the window (i.e. AutoCAD)
Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal Msg As Long) As Long
'declare API function to find a window (i.e. AutoCAD)
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal owner As Long, ByVal Title As String) As Long
'declare API function to display an "Open File" window
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
'Type structure for "Open File" window (see MSDN API help for more information of typedefs
Private 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
'Main program ... set project to default execute Sub Main
Sub Main()
'define variables
Dim CmdArg As String
Dim Ext As String
Dim LoadFile As Boolean
'get any command line arguments passed this should only be a file name if last 3 or 4 chars do not match an accepted
'file type, the user is notified below
CmdArg = Command()
'if we got a command line argument
If CmdArg <> "" Then
'lets see if there is a 3 char extension
If UCase(Mid$(CmdArg, Len(CmdArg) - 4, 1)) = "." Then
'if so grab the last 3 chars
Ext = UCase(Mid$(CmdArg, Len(CmdArg) - 3, 3))
'otherwise lets see if there is a 4 char extension
ElseIf UCase(Mid$(CmdArg, Len(CmdArg) - 5, 1)) = "." Then
'if so grab the last 4 chars
Ext = UCase(Mid$(CmdArg, Len(CmdArg) - 4, 4))
End If
'lets see if the extension (Ext) matches our filter for type
Select Case Ext
'list of acceptable file type extensions separated by comma, capitalized and enclosed in quotes
Case "BMP", "RLE", "DIB", "CAL", "RST", "GP4", "MIL", "CG4", "FLC", "FLI", "BIL", "IG4", "IGS", "JPE", "JPG", "JPEG", "PCX", "PCT", "PNG", "RLC", "TGA", "TIF", "TIFF"
'if the file was of the correct type (i.e. extension) set a boolean value to true
LoadFile = True
End Select
End If
'if we have a valid command line argument and it passed the extension test
If (CmdArg <> "") And (LoadFile = True) Then
'load the image identified by CmdArg
LoadImage (CmdArg)
'otherwise if we have a command line argument
ElseIf (CmdArg <> "") Then
'it did not pass the extension test so notify the user that it is not supported
MsgBox "Unrecognized File Format", vbExclamation, "InsertImage ERROR"
Else
'if we did not get a command line argument
'it is in a while statement just in case the "Open File" window returns
'an empty string, as such it will simply retain the open file dialog
While CmdArg = ""
'call the "Open File" window and grab the return value
CmdArg = Open_Comdlg32
Wend
'if the user didn't cancel the "Open File" window we should have a valid file name
If CmdArg <> "0" Then
'using the file name (i.e. CmdArg) call the LoadImage subroutine
LoadImage (CmdArg)
End If
End If
End Sub
'Code to display "Open File" dialog....
Function Open_Comdlg32()
'define variables
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim strFilter As String
'set our OpenFile object structure size to the code size of our variables
OpenFile.lStructSize = Len(OpenFile)
'assign the filter types
'that will be seen in the combo box on the window
'the format is simple to follow, "FILEDESC(*.EXT;*.EXT)" & Null char & "*.EXT;*.EXT" & Null Char
strFilter = "All Image Files" & Chr(0) & "*.bmp;*.rle;*.dib;*.cal;*.rst;*.gp4;*.mil;*.cg4;*.flc;*.fli;*.bil;*.ig4;*.igs;*.jpe;*.jpg;*.jpeg;*.pcx;*.pct;*.png;*.rlc;*.tga;*.tif;*.tiff" & Chr(0) & _
"BMP(*.bmp;*.rle;*.dib)" & Chr(0) & "*.bmp;*.rle;*.dib" & Chr(0) & _
"CALS1 (*.cal;*.rst;*.gp4;*.mil;*.cg4)" & Chr(0) & "*.cal;*.rst;*.gp4;*.mil;*.cg4" & Chr(0) & _
"FLIC (*.flc;*.fli)" & Chr(0) & "*.flc;*.fli" & Chr(0) & _
"GEOSPOT (*.bil)" & Chr(0) & "*.bil" & Chr(0) & _
"IG4 (*.ig4)" & Chr(0) & "*.ig4" & Chr(0) & _
"IGS (*.igs)" & Chr(0) & "*.igs" & Chr(0) & _
"JFIF (*.jpe;*.jpg;*.jpeg)" & Chr(0) & "*.jpe;*.jpg;*.jpeg" & Chr(0) & _
"PCX (*.pcx)" & Chr(0) & "*.pcx" & Chr(0) & _
"PICT (*.pct)" & Chr(0) & "*.pct" & Chr(0) & _
"PNG (*.png)" & Chr(0) & "*.png" & Chr(0) & _
"RLC (*.rlc)" & Chr(0) & "*.rlc" & Chr(0) & _
"TGA (*.tga)" & Chr(0) & "*.tga" & Chr(0) & _
"TIFF (*.tif;*.tiff)" & Chr(0) & "*.tif;*.tiff" & Chr(0)
'with our "Open File" window, use the following data
With OpenFile
.lpstrFilter = strFilter
.nFilterIndex = 1
.lpstrFile = String(4096, 0)
.nMaxFile = Len(.lpstrFile) - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = .nMaxFile
.lpstrTitle = "Select Image File" 'our open file title
.flags = 524288 'flags for open file new style with single file selections
End With
'call the API function, and pass out OpenFile struct to the command
'then grab the return value
lReturn = GetOpenFileName(OpenFile)
'if it does not return 0 the user pressed OK
If lReturn <> 0 Then
'so lets return the file name to the calling function
Open_Comdlg32 = OpenFile.lpstrFile
Else
'otherwise the user canceled so return a "0"
'note I used a string simply because it was simpler to facilitate
'the "string" type defined above
Open_Comdlg32 = "0"
End If
End Function
'sub to load the image into AutoCAD
Sub LoadImage(ByVal ImageName As String)
'Define our variables, note that AC(AutoCAD) and NewDwg are defined as objects this lets us load the
'required type libraries dynamically making it work for 2000, 2002, 2004 and 2005
Dim AC As Object
Dim NewDwg As Object
Dim InsPnt(2) As Double
'set the insertion point to 0,0,0
InsPnt(0) = 0#: InsPnt(1) = 0#: InsPnt(2) = 0#
'Set AC(AutoCAD) to the AutoCAD object by calling our subroutine below
Set AC = GetAcadObject
'Find the AutoCAD window, and show it maximized
ShowWindow FindWindow(0&, AC.Caption), &H3
'create a new drawing in AutoCAD
Set NewDwg = AC.Documents.Add()
'activate it
NewDwg.Activate
'Add a raster image into modelspace as specified by ImageName at our InsPnt with a scale of 1 and rotation of 0
NewDwg.ModelSpace.AddRaster ImageName, InsPnt, 1, 0
'zoom the drawing to extents
AC.ZoomExtents
End Sub
'Function to find AutoCAD or load it if not found
Function GetAcadObject() As Object
'Get the AutoCAD.Application as defined in the registry
Set GetAcadObject = GetObject(, "AutoCAD.Application")
'if we could not get it, then it is not running so...
If Err <> 0 Then
Err.Clear
'lets create it ..i.e. start AutoCAD
Set GetAcadObject = CreateObject("AutoCAD.Application")
If Err <> 0 Then
'if we can't start it then notify the user
MsgBox "Could not load or find AutoCAD.", vbExclamation
End
End If
End If
End Function
