Community
Hi @GKR2023. I see 2 different places that might need to be fixed, but not sure. Within your TraverseAssembly Sub routine, is the following line of code:
strName = oOcc.Definition.Document.FullDocumentName
That should probably end with FullFileName, instead of FullDocumentName. They will often contain the same value, but any time an iPart, iAssembly, or document with multiple ModelStates is encountered, the FullDocumentName will usually contain more information after the FullFileName portion, such as the iPart member name, iAssembly member name, or ModelState member name, within "<" & ">" characters. The way your code handles separating the different parts of file names out, that could definitely cause problems. The other line of code that looks wrong to me is the following line, within the Printdwg Sub routine:
oPath = oExportPath
The second variable being supplied to that Sub routine is "oExportFolder", not oExportPath, and the oExportPath variable is not declared or a value set to it anywhere within that Sub routine before it reaches that line. Then the lines of code you mentioned getting error feedback from uses that oPath variable. Just my initial thoughts from a quick read through of your overall code.
Edit: Another thing that might stump up your TraverseAssembly routine is if it encountered a 'virtual' component. Those would not have a Document to access its FullFileName or FullDocumentName from. You can filter them out by checking:
If TypeOf oOcc.Definition Is VirtualComponentDefinition Then Continue Forbut only after you have checked that the component is not suppressed, because accessing the Definition of a suppressed component results in an error.
Wesley Crihfield
(Not an Autodesk Employee)
Hi @GKR2023. I see 2 different places that might need to be fixed, but not sure. Within your TraverseAssembly Sub routine, is the following line of code:
strName = oOcc.Definition.Document.FullDocumentName
That should probably end with FullFileName, instead of FullDocumentName. They will often contain the same value, but any time an iPart, iAssembly, or document with multiple ModelStates is encountered, the FullDocumentName will usually contain more information after the FullFileName portion, such as the iPart member name, iAssembly member name, or ModelState member name, within "<" & ">" characters. The way your code handles separating the different parts of file names out, that could definitely cause problems. The other line of code that looks wrong to me is the following line, within the Printdwg Sub routine:
oPath = oExportPath
The second variable being supplied to that Sub routine is "oExportFolder", not oExportPath, and the oExportPath variable is not declared or a value set to it anywhere within that Sub routine before it reaches that line. Then the lines of code you mentioned getting error feedback from uses that oPath variable. Just my initial thoughts from a quick read through of your overall code.
Edit: Another thing that might stump up your TraverseAssembly routine is if it encountered a 'virtual' component. Those would not have a Document to access its FullFileName or FullDocumentName from. You can filter them out by checking:
If TypeOf oOcc.Definition Is VirtualComponentDefinition Then Continue Forbut only after you have checked that the component is not suppressed, because accessing the Definition of a suppressed component results in an error.
Wesley Crihfield
(Not an Autodesk Employee)
Accepted solution
This updated code seems to work. The issue was indeed with oExportPath.
Imports System.IO
Sub Main()
Break
Dim m_inventorApp As Inventor.Application = ThisApplication
Dim oDWGAddIn As TranslatorAddIn = Nothing
Dim i As Long
For i = 1 To m_inventorApp.ApplicationAddIns.Count
If m_inventorApp.ApplicationAddIns.Item(i).ClassIdString ="{C24E3AC2-122E-11D5-8E91-0010B541CD80}" Then
oDWGAddIn = m_inventorApp.ApplicationAddIns.Item(i)
Exit For
End If
Next
If oDWGAddIn Is Nothing Then
MsgBox("DWG add-in not found.")
Exit Sub
End If
If Not oDWGAddIn.Activated Then
oDWGAddIn.Activate()
End If
Dim doc As Document = ThisDoc.Document
Dim oFilePath As String = ThisDoc.Path
Dim oProjectNumber As String = Mid(oFilePath, 39, 5)
oExportFolder = "C:\Exports\03 - PDF Exports" & oProjectNumber & "\"
If System.IO.Directory.Exists(oExportFolder) = False Then
System.IO.Directory.CreateDirectory(oExportFolder)
ElseIf System.IO.Directory.Exists(oExportFolder) = True Then
'What to do with it if it does exist here.
End If
' Dim oExportPath As String = System.IO.Path.GetDirectoryName(doc.FullFileName) & "\ACAD"
' If Not System.IO.Directory.Exists(oExportPath) Then: System.IO.Directory.CreateDirectory(oExportPath): End If
Dim DrawList As New ArrayList
If doc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
'MainDoc(oExportPath)
Dim oAsmDoc As AssemblyDocument = ThisDoc.Document
MainDoc(oExportFolder)
TraverseAssembly(oAsmDoc.ComponentDefinition.Occurrences, 1, DrawList, oExportFolder)
Else
'Drawing/Presentation/Unknown = End script + message
i = MessageBox.Show("Huidige document is geen assembly", "Error", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
End If
m1 = MsgBox("Batchplot DWG complete", MessageBoxButtons.YesNo + MessageBoxIcon.Question, "Information")
If m1 = vbYes Then
Dim Proc As String = "Explorer.exe"
Dim Args As String = ControlChars.Quote & oExportFolder & ControlChars.Quote
Process.Start(Proc, Args)
End If
End Sub
Sub MainDoc(oExportFolder As String)
IDWName = ThisDoc.ChangeExtension(".idw")
DWGName = ThisDoc.ChangeExtension(".dwg")
FindDrawing(DWGName, IDWName, oExportFolder)
End Sub
Private Sub TraverseAssembly(Occurrences As ComponentOccurrences, Level As Integer, DrawList As ArrayList, oExportFolder As String)
Dim oOcc As ComponentOccurrence
For Each oOcc In Occurrences
If oOcc.Suppressed = False Then
If Not oOcc.BOMStructure = BOMStructureEnum.kReferenceBOMStructure Then
strName = oOcc.Definition.Document.FullDocumentName
If DrawList.Contains(strName) = False Then
IDWName = Left(strName, Len(strName) - 4) & ".idw"
DWGName = Left(strName, Len(strName) - 4) & ".dwg"
FindDrawing(DWGName, IDWName, oExportFolder)
DrawList.Add(strName)
End If
If oOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
TraverseAssembly(oOcc.SubOccurrences, Level + 1, DrawList, oExportFolder)
End If
End If
End If
Next
End Sub
Sub FindDrawing(DWGName As String, IDWName As String, oExportFolder As String)
If System.IO.File.Exists(DWGName) Then
Printdwg(DWGName, oExportFolder)
ElseIf System.IO.File.Exists(IDWName) Then
Printdwg(IDWName, oExportFolder)
'ThisApplication.Documents.Open(DWGName, True)
End If
End Sub
Sub Printdwg(oDocName As String, oExportFolder As String)
Dim oDoc As Document
Dim oApp As Inventor.Application = ThisApplication
oDoc = oApp.Documents.Open(oDocName, True)
oDoc.Activate
Try
Dim m_inventorApp As Inventor.Application = ThisApplication
Dim oNameValueMap As NameValueMap = m_inventorApp.TransientObjects.CreateNameValueMap
Dim strIniFile As String = "C:\$WorkingFolder\Settings\Inventor\Design Data\DWG-DXF\exportdwg.ini"
Call oNameValueMap.Add("Export_Acad_IniFile", strIniFile)
Dim oContext As TranslationContext
oContext = m_inventorApp.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
Dim oOutputFile As DataMedium = m_inventorApp.TransientObjects.CreateDataMedium
oPath = oExportPath
oFileName = Right(oDocName, Len(oDocName) - InStrRev(oDocName, "\", -1))
oFileName = Left(oFileName, Len(oFileName) - 4)
Dim oPropSet As PropertySet = oDoc.PropertySets.Item("Inventor Summary Information")
Dim oProp As Inventor.Property = oPropSet.Item("Revision Number")
oRevNum = oProp.Value
If oRevNum = "" Then
oRevtxt = ""
Else
oRevtxt = "-"
End If
'MsgBox(oExportPath & "\" & oFileName & oRevtxt & oRevNum & ".dwg")
oOutputFile.FileName = oExportFolder & "\" & oFileName & oRevtxt & oRevNum & ".dwg"
Dim oDWGAddIn As TranslatorAddIn = m_inventorApp.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")
Call oDWGAddIn.SaveCopyAs(m_inventorApp.ActiveDocument, oContext, oNameValueMap, oOutputFile)
Catch
i = MessageBox.Show("Unable to export drawing" & vbLf & oPath, "Error", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
Finally
oDoc.Close(True)
End Try
'oDoc.Close
End Sub
Kind regards,
Alexander Boogaard
This updated code seems to work. The issue was indeed with oExportPath.
Imports System.IO
Sub Main()
Break
Dim m_inventorApp As Inventor.Application = ThisApplication
Dim oDWGAddIn As TranslatorAddIn = Nothing
Dim i As Long
For i = 1 To m_inventorApp.ApplicationAddIns.Count
If m_inventorApp.ApplicationAddIns.Item(i).ClassIdString ="{C24E3AC2-122E-11D5-8E91-0010B541CD80}" Then
oDWGAddIn = m_inventorApp.ApplicationAddIns.Item(i)
Exit For
End If
Next
If oDWGAddIn Is Nothing Then
MsgBox("DWG add-in not found.")
Exit Sub
End If
If Not oDWGAddIn.Activated Then
oDWGAddIn.Activate()
End If
Dim doc As Document = ThisDoc.Document
Dim oFilePath As String = ThisDoc.Path
Dim oProjectNumber As String = Mid(oFilePath, 39, 5)
oExportFolder = "C:\Exports\03 - PDF Exports" & oProjectNumber & "\"
If System.IO.Directory.Exists(oExportFolder) = False Then
System.IO.Directory.CreateDirectory(oExportFolder)
ElseIf System.IO.Directory.Exists(oExportFolder) = True Then
'What to do with it if it does exist here.
End If
' Dim oExportPath As String = System.IO.Path.GetDirectoryName(doc.FullFileName) & "\ACAD"
' If Not System.IO.Directory.Exists(oExportPath) Then: System.IO.Directory.CreateDirectory(oExportPath): End If
Dim DrawList As New ArrayList
If doc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
'MainDoc(oExportPath)
Dim oAsmDoc As AssemblyDocument = ThisDoc.Document
MainDoc(oExportFolder)
TraverseAssembly(oAsmDoc.ComponentDefinition.Occurrences, 1, DrawList, oExportFolder)
Else
'Drawing/Presentation/Unknown = End script + message
i = MessageBox.Show("Huidige document is geen assembly", "Error", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
End If
m1 = MsgBox("Batchplot DWG complete", MessageBoxButtons.YesNo + MessageBoxIcon.Question, "Information")
If m1 = vbYes Then
Dim Proc As String = "Explorer.exe"
Dim Args As String = ControlChars.Quote & oExportFolder & ControlChars.Quote
Process.Start(Proc, Args)
End If
End Sub
Sub MainDoc(oExportFolder As String)
IDWName = ThisDoc.ChangeExtension(".idw")
DWGName = ThisDoc.ChangeExtension(".dwg")
FindDrawing(DWGName, IDWName, oExportFolder)
End Sub
Private Sub TraverseAssembly(Occurrences As ComponentOccurrences, Level As Integer, DrawList As ArrayList, oExportFolder As String)
Dim oOcc As ComponentOccurrence
For Each oOcc In Occurrences
If oOcc.Suppressed = False Then
If Not oOcc.BOMStructure = BOMStructureEnum.kReferenceBOMStructure Then
strName = oOcc.Definition.Document.FullDocumentName
If DrawList.Contains(strName) = False Then
IDWName = Left(strName, Len(strName) - 4) & ".idw"
DWGName = Left(strName, Len(strName) - 4) & ".dwg"
FindDrawing(DWGName, IDWName, oExportFolder)
DrawList.Add(strName)
End If
If oOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
TraverseAssembly(oOcc.SubOccurrences, Level + 1, DrawList, oExportFolder)
End If
End If
End If
Next
End Sub
Sub FindDrawing(DWGName As String, IDWName As String, oExportFolder As String)
If System.IO.File.Exists(DWGName) Then
Printdwg(DWGName, oExportFolder)
ElseIf System.IO.File.Exists(IDWName) Then
Printdwg(IDWName, oExportFolder)
'ThisApplication.Documents.Open(DWGName, True)
End If
End Sub
Sub Printdwg(oDocName As String, oExportFolder As String)
Dim oDoc As Document
Dim oApp As Inventor.Application = ThisApplication
oDoc = oApp.Documents.Open(oDocName, True)
oDoc.Activate
Try
Dim m_inventorApp As Inventor.Application = ThisApplication
Dim oNameValueMap As NameValueMap = m_inventorApp.TransientObjects.CreateNameValueMap
Dim strIniFile As String = "C:\$WorkingFolder\Settings\Inventor\Design Data\DWG-DXF\exportdwg.ini"
Call oNameValueMap.Add("Export_Acad_IniFile", strIniFile)
Dim oContext As TranslationContext
oContext = m_inventorApp.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
Dim oOutputFile As DataMedium = m_inventorApp.TransientObjects.CreateDataMedium
oPath = oExportPath
oFileName = Right(oDocName, Len(oDocName) - InStrRev(oDocName, "\", -1))
oFileName = Left(oFileName, Len(oFileName) - 4)
Dim oPropSet As PropertySet = oDoc.PropertySets.Item("Inventor Summary Information")
Dim oProp As Inventor.Property = oPropSet.Item("Revision Number")
oRevNum = oProp.Value
If oRevNum = "" Then
oRevtxt = ""
Else
oRevtxt = "-"
End If
'MsgBox(oExportPath & "\" & oFileName & oRevtxt & oRevNum & ".dwg")
oOutputFile.FileName = oExportFolder & "\" & oFileName & oRevtxt & oRevNum & ".dwg"
Dim oDWGAddIn As TranslatorAddIn = m_inventorApp.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")
Call oDWGAddIn.SaveCopyAs(m_inventorApp.ActiveDocument, oContext, oNameValueMap, oOutputFile)
Catch
i = MessageBox.Show("Unable to export drawing" & vbLf & oPath, "Error", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
Finally
oDoc.Close(True)
End Try
'oDoc.Close
End Sub
Kind regards,
Alexander Boogaard
Forums Links
Can't find what you're looking for? Ask the community or share your knowledge.
Post to forums
