Is there someway to launch an external iLogic rule with VBA?. I'd like to add a button to run the iLogic rule.
Lance W.
Inventor Pro 2013 (PDS Ultimate)
Vault Pro 2013
Windows 7 64
Xeon 2.4 Ghz 12GB
Solved! Go to Solution.
Link copied
Is there someway to launch an external iLogic rule with VBA?. I'd like to add a button to run the iLogic rule.
Solved! Go to Solution.
Regarding your error. My bad. The line with the error should start with:
AddIn
Not
DXFAddin
Regarding using the Print to PDF.
The code is still there.
You just need to UNCOMMENT it and delete or Comment the current PDF Translator code in the Traslator Sub Routine.
For instance change the Elseif FileType = ".pdf" section as follows.
'...
ElseIf FileType = ".pdf" Then
Dim oPrintMgr as Inventor.PrintManager
Set oPrintMgr = ThisApplication.ActiveDocument.PrintManager
oPrintMgr.Printer = "Adobe PDF"
oPrintMgr.ColorMode = kPrintGrayScale
oPrintMgr.ColorMode = kPrintColorPalette
oPrintMgr.NumberOfCopies = 1
oPrintMgr.Orientation = kPortraitOrientation
oPrintMgr.Orientation = kLandscapeOrientation
oPrintMgr.PaperSize = kPaperSizeA4
oPrintMgr.SubmitPrint
Exit Sub
End If
I have correct the AddIn 🙂 but don't work again 🙂 excuse me but i don'k know nothink in vba. When this code works i try to change printer 😄
Ah! I missed something there. To make the code work in my environment I had to edit some of the parameters as you had hard coded them for your network / PC.
Remove the "Nothing, " parameter from the statement.
Beyond that I cannot do much more for you without sitting beside you at your workstation.
If you want to use VBA or iLogic then you are going to have to be willing to learn somethning about the topic.
OK 😄 it's work perfectly!! Thank you very much!!!
There is one little things, when he save the dxf file the neme of the file il the Part Number of iProperties, i need the name is the name of the file.
For exemple
SO37697.ipt ==> SO37697.dxf
Because in my iLogic for first i do this:
iProperties.Value("Custom", "FileName") = ThisDoc.FileName(True) iProperties.Value("Project", "Part Number") = ThisDoc.FileName(False)
d
Varga,
If you want the filename then you can derive it from the oDocument object.
The property you want is called FullFileName.
(When in the VBA environment place a period after any object to see what properties and methods it contains.)
'-----
' Change the sub routine: Output_DXF_PDF to:
'-----
Public Sub Output_DXF_PDF()
Dim oDocument As Inventor.Document
Dim sPath As String
Dim PN As String
' VBA requires the keyword "Set" when instantiating an Object variable
Set oDocument = ThisApplication.ActiveDocument
' Set Path and base file name
sPath = "C:\Users\varga\Desktop\"
PN = GetFileName(oDocument.FullFileName)
PN = sPath & PN
' Call the translation sub routines
Call TranslateFile(PN, ".dxf", oDocument)
Call TranslateFile(PN, ".pdf", oDocument)
' Clean up objects
Set oDocument = Nothing
End Sub
'-----
' Add the following Function (It is used in the above sub routine.)
'-----
Private Function GetFileName(Byval sFullFileName as string) as string
Dim sFileName as string
Dim nPos as integer
Dim sFileName = sFullFileName
nPos = instrRev$(sFullFileName,"\")
if nPos > 0 then
sFileName = Mid$(sFullFileName,nPos+1)
End if
GetFileName = sFileName
End Function
So 😄 i have modify all for my need. It works fine but i have the last bug. This in my final code:
'Crea i PDF con adobe PDF Option Explicit Public Sub DXF_PDF_Creator() Dim oDocument As Inventor.Document Dim oPropertySet As Inventor.PropertySet Dim oProperty As Inventor.Property Dim sPath As String Dim PN As String ' VBA requires the keyword "Set" when instantiating an Object variable Set oDocument = ThisApplication.ActiveDocument Set oPropertySet = oDocument.PropertySets(("Design Tracking Properties")) Set oProperty = oPropertySet("Part Number") ' Set Path and base file name sPath = "C:\Users\varga\Desktop\" PN = GetFileName(oDocument.FullFileName) PN = sPath & PN ' Call the translation sub routines Call TranslateFile(PN, ".dxf", oDocument) Call TranslateFile(PN, ".pdf", oDocument) ' Clean up object Set oProperty = Nothing Set oPropertySet = Nothing Set oDocument = Nothing End Sub Private Function GetFileName(ByVal sFullFileName As String) As String Dim sFileName As String Dim nPos As Integer sFileName = sFullFileName nPos = InStrRev(sFullFileName, "\") If nPos > 0 Then sFileName = Mid$(sFullFileName, nPos + 1) End If GetFileName = sFileName End Function Public Sub TranslateFile(ByVal BaseFileName As String, ByVal FileType As String, oDocument As Inventor.Document) Dim PN As String PN = BaseFileName & FileType ' Define Variables Dim AddIn As Inventor.TranslatorAddIn Dim oContext As Inventor.TranslationContext Dim oOptions As Inventor.NameValueMap Dim oDataMedium As Inventor.DataMedium Dim SheetSize As DrawingSheetSizeEnum Dim SheetOrientation As PageOrientationTypeEnum ' Define Context, Options and DataMediums Set oContext = ThisApplication.TransientObjects.CreateTranslationContext oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium If FileType = ".dxf" Then ' Get the DXF translator Add-In. Set AddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}") ' Check whether the translator has 'SaveCopyAs' options If AddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then Dim strIniFile As String strIniFile = "Z:\Autodesk\Inventor11\Design Data\DWG-DXF\fornitori.ini" oOptions.Value("Export_Acad_IniFile") = strIniFile End If ElseIf FileType = ".pdf" Then Dim oPrintMgr As Inventor.PrintManager SheetOrientation = ThisApplication.ActiveDocument.ActiveSheet.Orientation 'SheetSize = ThisApplication.ActiveDocument.ActiveSheet.Size 'Create a PDF File with the print manager Set oPrintMgr = ThisApplication.ActiveDocument.PrintManager oPrintMgr.Printer = "Adobe PDF" 'oPrintMgr.ColorMode = kPrintGrayScale 'oPrintMgr.ColorMode = kPrintColorPalette oPrintMgr.NumberOfCopies = 1 ' Imposta l'orientazione del PDF If SheetOrientation = kLandscapePageOrientation Then oPrintMgr.Orientation = kLandscapeOrientation ElseIf SheetOrientation = kPortraitPageOrientation Then oPrintMgr.Orientation = kPortraitOrientation End If 'oPrintMgr.Orientation = kPortraitOrientation 'oPrintMgr.Orientation = kLandscapeOrientation oPrintMgr.PaperSize = kPaperSizeA4 oPrintMgr.SubmitPrint Exit Sub End If ' Set the destination file name oDataMedium.FileName = PN '----- ' Create a DXF document Call AddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium) ' Clean up objects Set oDataMedium = Nothing Set oOptions = Nothing Set oContext = Nothing Set AddIn = Nothing '---------------------- End Sub
For exemple with file SO37697.dwg open in inventor when i lunch this code he do two file SO37697.dwg.dxf and SO37697.pdf the dxf is wrong, and he doesn't consider tht .ini file!!! Why??
Varga,
I have reached the limit of what I can do without being at your desk.
It might be that your ini file is not at the path you have in code. Those .INI files for DWG/DXF are a mystery to me. Historically the output options tend to be sticky. You might want to manually dump a DXF file and look at the output option settings. Make sure they are set to "Drawing" Ect...
You might put a break in your code just before the section "If AddIn.HasSaveCopyAsOptions..." and step ;through your code with F8 in debug mode to see what is happening. (To put a break on a line of code click in the gray column to the far left in the text editor A Brown dot should appear there. Run your program. It will stop when it reaches the brown dot. Use F8 to step line by line forward. Hover over your variables they should display their current contents when in Debug mode.)
The VBA Help for Programming is in Inventor on the upper right, under the blue question mark pull down. Select "Additional Resoruces | Programming Help" Use the search tab of the help dialog and enter. "Addin DXF" Select "TranslatorAddIn Interface " Scroll down to the DXF example.
Ok thank you very much i look for the solution, i think is guilt of the file name script which put the extension .dwg at the end of the name so if he create the dxf the result is filename.dwg.dxf 😄
Thank YOU for all you help!
No Problem,
Change the GetFileName sub routine to the following to remove the .DWG from the filename.
Private Function GetFileName(ByVal sFullFileName As String) As String
Dim sFileName As String
Dim nPos As Integer
sFileName = sFullFileName
nPos = InStrRev(sFullFileName, "\")
If nPos > 0 Then
sFileName = Mid$(sFullFileName, nPos + 1)
End If
nPos = InStrRev(sFullFileName, ".")
If nPos > 0 then
sFileName = Left$(sFileName, nPos-1)
End if
GetFileName = sFileName
End Function
Ok but there is somethink who i don't understand:
I open thi file: Z:\DISEGNI_INVENTOR\MO\MO37618.dwg
Private Function GetFileName(ByVal sFullFileName As String) As String => (Here GetFileName is Z:\DISEGNI_INVENTOR\MO\MO37618.dwg)
Dim sFileName As String ==> (sFileName is MO37618.dwg)
Dim nPos As Integer ==> (nPos in 31)
sFileName = sFullFileName ==> (sFileName is MO37618.dwg and sFullFileName is Z:\DISEGNI_INVENTOR\MO\MO37618.dwg)
nPos = InStrRev(sFullFileName, "\")
If nPos > 0 Then
sFileName = Mid$(sFullFileName, nPos + 1) ==> (sFileName is MO37618.dwg)
End If
nPos = InStrRev(sFullFileName, ".") ==> (nPos in 31)
If nPos > 0 then
sFileName = Left$(sFileName, nPos-1) ==> (sFileName is MO37618.dwg)
End if
GetFileName = sFileName ==> (GetFileName and sFileName is MO37618.dwg)
End Function
so after this the pdf when i go to save is MO37618.dwg.dxf 🙂
I study this code but i don't find the error 😄
Yesssssssssssss i have solved!!!!
Now is perfect!!!!! This is the correct function for the name .-D
Private Function GetFileName(ByVal sFullFileName As String) As String Dim sFileName As String Dim nPos As Integer Dim nPosf As Integer sFileName = sFullFileName nPos = InStrRev(sFullFileName, "\") If nPos > 0 Then sFileName = Mid$(sFullFileName, nPos + 1) End If nPosf = InStr(sFullFileName, ".") If nPos > 0 Then sFileName = Left$(sFileName, nPosf - nPos - 1) End If GetFileName = sFileName End Function
Glad your starting to get into programming.
In any case I am guilty of not testing my code before I post it.
Here is the GetFileName() function I posted Corrected.
-----
Private Function GetFileName(ByVal sFullFileName As String) As String
Dim sFileName As String
Dim nPos As Integer
FileName = sFullFileName
nPos = InStrRev(sFileName, "\")
If nPos > 0 Then
FileName = Mid$(sFileName, nPos + 1)
End If
nPos = InStrRev(sFileName, ".")
If nPos > 0 Then
sFileName = Left$(sFileName, nPos - 1)
End If
GetFileName = sFileName
End Function
Hi, I have read this post and I am unable to get it to work for my ilogic rule.
Ive created the external ilogic rule and saved it in my documents folder(is this where it should be, or should it be in my inventor files?)
Anyways, now that I have the VBA created and a button made to access the macro, its not doing anything once it is pressed. I am not sure where I went wrong here, but here is the VBA Code I have from the 1st page:
Public Sub ZXPlane()
RuniLogic "ZXPlane"
End Sub
Public Sub RuniLogic(ByVal RuleName As String)
Dim iLogicAuto As Object
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
If oDoc Is Nothing Then
MsgBox "Missing Inventor Document"
Exit Sub
End If
Set iLogicAuto = GetiLogicAddin(ThisApplication)
If (iLogicAuto Is Nothing) Then Exit Sub
iLogicAuto.RunExternalRule oDoc, RuleName
End Sub
Function GetiLogicAddin(oApplication As Inventor.Application) As Object
Set addIns = oApplication.ApplicationAddIns
'Find the add-in you are looking for
Dim addIn As ApplicationAddIn
On Error GoTo NotFound
Set addIn = oApplication.ApplicationAddIns.ItemById("{3bdd8d79?-2179-4b11-8a5a-257b1c0263ac}")
If (addIn Is Nothing) Then Exit Function
addIn.Activate
Set GetiLogicAddin = addIn.Automation
Exit Function
NotFound:
End Function
Is there something that I did wrong when I changed the 1st 2 lines?
please look at the line "itembyID", there is "question mark" over there. it happens when you copy and paste code from webbrowser.
jcneal, Thanks alot!!!! I'm so happy. I've tried to get this function working alots of time. Now it works!
Please see the example to export PDF, and you could get the tips to fix the issue -
Public Sub PublishPDF()
' Get the PDF translator Add-In.
Dim PDFAddIn As TranslatorAddIn
Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
'Set a reference to the active document (the document to be published).
Dim oDocument As Document
Set oDocument = ThisApplication.ActiveDocument
Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism
' Create a NameValueMap object
Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
' Create a DataMedium object
Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
' Check whether the translator has 'SaveCopyAs' options
If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
' Options for drawings...
oOptions.Value("All_Color_AS_Black") = 0
'oOptions.Value("Remove_Line_Weights") = 0
'oOptions.Value("Vector_Resolution") = 400
'oOptions.Value("Sheet_Range") = kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2
'oOptions.Value("Custom_End_Sheet") = 4
End If
'Set the destination file name
oDataMedium.FileName = "c:\temp\test.pdf"
'Publish document.
Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub
Please see the example to export PDF, and you could get the tips to fix the issue -
Public Sub PublishPDF()
' Get the PDF translator Add-In.
Dim PDFAddIn As TranslatorAddIn
Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
'Set a reference to the active document (the document to be published).
Dim oDocument As Document
Set oDocument = ThisApplication.ActiveDocument
Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism
' Create a NameValueMap object
Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
' Create a DataMedium object
Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
' Check whether the translator has 'SaveCopyAs' options
If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
' Options for drawings...
oOptions.Value("All_Color_AS_Black") = 0
'oOptions.Value("Remove_Line_Weights") = 0
'oOptions.Value("Vector_Resolution") = 400
'oOptions.Value("Sheet_Range") = kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2
'oOptions.Value("Custom_End_Sheet") = 4
End If
'Set the destination file name
oDataMedium.FileName = "c:\temp\test.pdf"
'Publish document.
Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub
Hi to all.
I'm with Inventor 2021
and i have an exit sub when--> RuniLogic "MyRule"
in
[...] If (iLogicAuto Is Nothing) Then Exit Sub[...]
Maybe the code changes for Inventor 2021?
Can someone help me?
Thanks