Execute iLogic Rule Called "ExportDXF" from VBA

[EidenC]

What I have is an External iLogic rule named "ExportDXF" that I would like to execute from a Macro. I would like to do this so that I can put it into a button on the quick access bar.

Thanks in advance.

Chris

[EidenC]

I found this code in the forums, but haven't been able to get it to work. Could anyone tell me where I am going wrong?

Thanks in advance,

Chris

Sub RuniLogicRule()

Dim iLogicAuto As Object
Set iLogicAuto = GetiLogicAddin(ThisApplication)
If (iLogicAuto Is Nothing) Then Exit Sub

Dim doc As Document
Set doc = ThisApplication.ActiveDocument
Dim ruleName As String
ruleName = "ExportDXF"
Dim rule As Object
Set rule = iLogicAuto.GetRule(doc, "ExportDXF")
If (rule Is Nothing) Then
  Call MsgBox("No rule named " & ruleName & " was found in the document.")
  Exit Sub
End If

Dim i As Integer
i = iLogicAuto.RunRuleDirect(rule)

End Sub


Function GetiLogicAddin(oApplication As Inventor.Application) As Object
Set addIns = oApplication.ApplicationAddIns

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

I am trying to run an external iLogic rule, however I put the rule in a drawing template file as well as in Inventor. No luck either way.

[MjDeck]

Instead of running iLogic, you can probably do everything in VBA.  It should be easy to convert your iLogic rule to VBA.   Can you post your ExportDXF rule?  It might be based on the PublishDXF example from the Inventor API help.

[EidenC]

That would be awesome if I could do that. I tried and tried to get the iLogic code changed to work within VBA, but couldn't get it to. So, I decided to try and got his route instead. If you could help get this tranlsated to VBA that would be great. I have 2 different codes. The first is to DXF out the file and the second is to PDF out the file. Each one goes to a specific folder on our server.

Thanks in advance,

Chris

' Get the DXF translator Add-In.
Dim DXFAddIn As TranslatorAddIn
DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
'Set a reference to the active document (the document to be published).
Dim oDocument As Document
oDocument = ThisApplication.ActiveDocument
Dim oContext As TranslationContext
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
' Create a NameValueMap object
Dim oOptions As NameValueMap
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
' Create a DataMedium object
Dim oDataMedium As DataMedium
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

' Sets directory for file save
Dim DXFDirectory As String
DXFDirectory = "\\ServerName\Shared\DXF Folder\"
' Sets save name as iProperties value
Dim SaveName As String
SaveName = iProperties.Value("Project", "Part Number")

If Len(Dir(DXFDirectory, vbDirectory)) = 0 Then
	MkDir (DXFDirectory)
End If

' Check whether the translator has 'SaveCopyAs' options
If DXFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
Dim strIniFile As String
strIniFile = "\\HMI-ENGINEERING\Inventor_Data\Miscellaneous\dxf.ini"
' Create the name-value that specifies the ini file to use.
oOptions.Value("Export_Acad_IniFile") = strIniFile
End If
'Set the destination file name
oDataMedium.FileName = ThisDoc.PathAndFileName(False) 
oDataMedium.FileName = DXFDirectory & SaveName & ".dxf"
'Publish document.
DXFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
'Launch the dxf file in whatever application Windows is set to open this document type with
i = MessageBox.Show("Preview the DXF file?", "DXF Preview",MessageBoxButtons.YesNo,MessageBoxIcon.Question)
If i = vbYes Then ThisDoc.Launch(oDataMedium.FileName)

path_and_name = ThisDoc.PathAndFileName(False) ' without extension
PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oDocument = ThisApplication.ActiveDocument
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

If PDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
	oOptions.Value("All_Color_AS_Black") = 1
	oOptions.Value("Remove_Line_Weights") = 1
	oOptions.Value("Vector_Resolution") = 400
	oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
'	oOptions.Value("Custom_Begin_Sheet") = 2
'	oOptions.Value("Custom_End_Sheet") = 4
End If

' Sets GetSetting strings
Dim GetCustomer As String
	GetCustomer = GetSetting("Inventor PDF Location", "PDFLocation", "Customer", "")
Dim GetSubFolder As String
	GetSubFolder = GetSetting("Inventor PDF Location", "PDFLocation", "SubFolder", "")
	
' Sets directory for file save
Dim PDFDirectory As String
PDFDirectory = "\\ServerName\E\PRINTS\" & GetCustomer & "\" & GetSubFolder & "\" & "PDF Prints\"
' Sets save name as iProperties value
Dim SaveName As String
SaveName = iProperties.Value("Project", "Part Number")

If Len(Dir(PDFDirectory, vbDirectory)) = 0 Then
	MkDir (PDFDirectory)
End If
'Set the destination file name
oDataMedium.FileName = PDFDirectory & SaveName & ".pdf"
'Publish document
PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions,oDataMedium)
'Launch the dxf file in whatever application Windows is set to open this document type with
i = MessageBox.Show("Preview the PDF file?", "PDF Preview",MessageBoxButtons.YesNo,MessageBoxIcon.Question)
If i = vbYes Then ThisDoc.Launch(oDataMedium.FileName) 

[MjDeck]

Here is the VBA version.  Some things are a bit harder to do in VBA, and I'm not an expert.  But this should work:

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Sub ExportDXF()

' Get the DXF translator Add-In.
Dim DXFAddIn As TranslatorAddIn
Set DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
'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 = IOMechanismEnum.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

' Sets directory for file save
Dim DXFDirectory As String
DXFDirectory = "\\ServerName\Shared\DXF Folder\"
' Sets save name as iProperties value
Dim SaveName As String
'SaveName = iProperties.Value("Project", "Part Number")
SaveName = oDocument.PropertySets("Design Tracking Properties").Item("Part Number").Value

If Len(Dir(DXFDirectory, vbDirectory)) = 0 Then
    MkDir (DXFDirectory)
End If

' Check whether the translator has 'SaveCopyAs' options
If DXFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
Dim strIniFile As String
strIniFile = "\\HMI-ENGINEERING\Inventor_Data\Miscellaneous\dxf.ini"
' Create the name-value that specifies the ini file to use.
oOptions.Value("Export_Acad_IniFile") = strIniFile
End If
'Set the destination file name
oDataMedium.fileName = DXFDirectory & SaveName & ".dxf"
'Publish document.
Call DXFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
'Launch the dxf file in whatever application Windows is set to open this document type with
i = MsgBox("Preview the DXF file?", vbYesNo, "DXF Preview")
If i = vbYes Then Call LaunchFile(oDataMedium.fileName)

End Sub

Sub ExportPDF()
Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
Dim oDocument As Document
Set oDocument = ThisApplication.ActiveDocument
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

If PDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
    oOptions.Value("All_Color_AS_Black") = 1
    oOptions.Value("Remove_Line_Weights") = 1
    oOptions.Value("Vector_Resolution") = 400
    oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
'   oOptions.Value("Custom_Begin_Sheet") = 2
'   oOptions.Value("Custom_End_Sheet") = 4
End If

' Sets GetSetting strings
Dim GetCustomer As String
    GetCustomer = GetSetting("Inventor PDF Location", "PDFLocation", "Customer", "")
Dim GetSubFolder As String
    GetSubFolder = GetSetting("Inventor PDF Location", "PDFLocation", "SubFolder", "")
    
' Sets directory for file save
Dim PDFDirectory As String
PDFDirectory = "\\ServerName\E\PRINTS\" & GetCustomer & "\" & GetSubFolder & "\" & "PDF Prints\"

' Sets save name as iProperties value
Dim SaveName As String
SaveName = oDocument.PropertySets("Design Tracking Properties").Item("Part Number").Value

Dim dirCreateOk As Boolean
dirCreateOk = CreateFolder(PDFDirectory)
If (Not dirCreateOk) Then
  MsgBox ("Could not create the directory:" & vbCrLf & PDFDirectory)
  Return
End If
'Set the destination file name
oDataMedium.fileName = PDFDirectory & SaveName & ".pdf"
'Publish document
Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
'Launch the dxf file in whatever application Windows is set to open this document type with
i = MsgBox("Preview the PDF file?", vbYesNo, "PDF Preview")
If i = vbYes Then Call LaunchFile(oDataMedium.fileName)
End Sub

Public Sub LaunchFile(pathName As String)
 Dim dirName As String
 dirName = pathName
 Dim fileName As String
 fileName = pathName
  Dim i As Long
    For i = Len(pathName) To 1 Step -1
      If (Mid(pathName, i, 1) = "\") Then
        dirName = Left(pathName, i - 1)
        fileName = Right(pathName, Len(pathName) - i)
        Exit For
      End If
    Next
 Dim ret As Long
 ret = ShellExecute(0, vbNullString, pathName, vbNullString, dirName, 1)
 Debug.Print ("return from ShellExecute = " & ret)
End Sub

' From http://www.developerfusion.com/code/1867/creating-folders-using-recursion/
Public Function CreateFolder(destDir As String) As Boolean
   Dim i As Long
   Dim prevDir As String
    
   On Error Resume Next
    
   For i = Len(destDir) To 1 Step -1
       If Mid(destDir, i, 1) = "\" Then
           prevDir = Left(destDir, i - 1)
           Exit For
       End If
   Next i
    
   If prevDir = "" Then
     CreateFolder = False
     Exit Function
   End If
   Debug.Print ("prevDir = " & prevDir)
   If Not Len(Dir(prevDir & "\", vbDirectory)) > 0 Then
       If Not CreateFolder(prevDir) Then
         CreateFolder = False
         Exit Function
       End If
   End If
    
   On Error GoTo errDirMake
   If Not Len(Dir(destDir, vbDirectory)) > 0 Then
     MkDir destDir
   End If
   CreateFolder = True
   Exit Function
    
errDirMake:
   CreateFolder = False

End Function

[EidenC]

It errors out at the following lines:

Set DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3?AC4-122E-11D5-8E91-0010B541CD80}")

And

Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6F?D96-2F4D-42CE-8BE0-8AEA580399E4}")

The Run-Time Error that comes up is "Method 'ItemById' of object 'ApplicationAddIns' failed.

 This is the same spot that I kept having issues with. I could never get passed this spot. I am not sure if the Item ID is incorrect or???

Thanks for all your help so far.

[MjDeck · Accepted solution]

For some reason, cut and paste from this forum will introduce ? characters in some text.  You can see it in those lines that you posted.  Please try the attached text file ExportDxfPdf.txt

[EidenC]

Wow! Thanks for all the help. I have been working on this for days now. It works fantastic.

Thanks again,

Chris

[EidenC]

I was wondering if anyone could help me with one last thing. I am trying to figure out how to get the DXF export code to do all sheets? It will only currently DXF out the selected sheet.

Thanks,

Chris

[EidenC]

Nevermind... Had to fix the .ini file.

Works Great.

Thanks,

Chris

[Anonymous]

Does this not produce a Zip file with the DXF in side? any idea how to get arroun that? 

[Anonymous]

What I have to do? I have files of Drawings for Samsung projects and the NC Machine shop wants me to do them with DXF Files ?
What you want me to do?

[lrebolledo]

Public Sub LaunchMyRule1() '<--- This is what you would tie to a button in a toolbar.

RuniLogic "Rule1"

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

Dim rule As Object
Set rule = iLogicAuto.GetRule(oDoc, RuleName)

Dim i As Integer
i = iLogicAuto.RunRuleDirect(rule)


End Sub

Function GetiLogicAddin(oApplication As Inventor.Application) As Object
Dim addIns As ApplicationAddIns
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