Hello
Try this one. Don't forget to add the reference to the Microsoft Scripting Runtime in VBA Editor --> Tools --> References or it will fail.
Sub InsertImageasSketchSymbol()
'Add a reference to Microsoft Scripting Runtime !!!
Dim oDoc As DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oImgFN As String
oImgFN = OpenFileDlg '"C:\YOURFILENAME.PNG"
If oImgFN = "" Then Exit Sub
Dim fso As New FileSystemObject
Dim sExt As String
sExt = "." & fso.GetExtensionName(oImgFN)
Dim sPicName As String
sPicName = Replace(fso.GetFileName(oImgFN), sExt, "")
Dim oSkSymDef As SketchedSymbolDefinition
On Error Resume Next
Set oSkSymDef = oDoc.SketchedSymbolDefinitions.Add("Pic_" & sPicName)
If Err.Number <> 0 Then
Set oSkSymDef = oDoc.SketchedSymbolDefinitions.item("Pic_" & sPicName)
End If
Dim oPoint2d As Point2d
'Suggest adding your image at coordinate 0,0. You may like to revise this to suit your application.
Set oPoint2d = ThisApplication.TransientGeometry.CreatePoint2d(0, 0)
Dim oSK As DrawingSketch
Set oSK = Nothing
oSkSymDef.Edit oSK
oSK.SketchImages.Add oImgFN, oPoint2d, False
oSkSymDef.ExitEdit
Dim oSkSym As SketchedSymbol
Set oSkSym = oDoc.ActiveSheet.SketchedSymbols.Add(oSkSymDef, oPoint2d, 0, 0.25) '<------ 0 is the rotation, 0.25 is the scale factor
'Then oSkSym is the object you can manipulate to suit your application.
End Sub
Private Function OpenFileDlg() As String
' Create a new FileDialog object.
Dim oFileDlg As FileDialog
Call ThisApplication.CreateFileDialog(oFileDlg)
' Define the filter to select part and assembly files or any file.
'oFileDlg.Filter = "Inventor Files (*.iam;*.ipt)|*.iam;*.ipt|All Files (*.*)|*.*"
oFileDlg.filter = "All Image Files|*.bmp;*.gif;*.jpg;*.png;*.tif|BMP (*.bmp)|*.bmp|GIF (*.gif)|*.gif|JPEG (*.jpg)|*.jpg|PNG (*.png)|*.png|TIFF (*.tif)|*.tif"
' Define the part and assembly files filter to be the default filter.
oFileDlg.FilterIndex = 1
' Set the title for the dialog.
oFileDlg.DialogTitle = "Open File Test"
' Set the initial directory that will be displayed in the dialog.
oFileDlg.InitialDirectory = "C:\"
' Set the flag so an error will be raised if the user clicks the Cancel button.
oFileDlg.CancelError = True
' Show the open dialog. The same procedure is also used for the Save dialog.
' The commented code can be used for the Save dialog.
On Error Resume Next
oFileDlg.ShowOpen
' oFileDlg.ShowSave
' If an error was raised, the user clicked cancel, otherwise display the filename.
If Err Then
MsgBox "User cancelled out of dialog"
OpenFileDlg = ""
ElseIf oFileDlg.fileName <> "" Then
'MsgBox "File " & oFileDlg.filename & " was selected."
OpenFileDlg = oFileDlg.fileName
End If
End Function
R. Krieg
RKW Solutions
www.rkw-solutions.com