Export Drawing dimension to excel

[eladm]

Hi

I need help with ilogic rule to export all drawing dimensions to Excel

Not VBA , some of the dimeson  have tolerance

regards

[aelqabbany]

Could you upload a non-confidential drawing so that I can take a look?

[bradeneuropeArthur]

Dim a As Inventor.DrawingDocument = ThisDrawing.Document
Dim s As Inventor.Sheet = a.ActiveSheet


Dim i As Integer = 1
For Each b As Inventor.DrawingDimension In s.DrawingDimensions
	i=i+1
	GoExcel.CellValue("C:\TEMP\DrawingDimensions.xlsx", "Sheet1", "A" & i) = b.Text.Text.ToString
	Next

Try this:

Make in your C:\Temp\DrawingDimenions.xlsx as new file first!

[eladm]

Hi

Not working

The Sheet excel is empty

[bradeneuropeArthur]

Can you make a screenshot of the Excel sheet.

is the sheetname "sheet1"

[bradeneuropeArthur]

Dim a As Inventor.DrawingDocument = ThisDrawing.Document
Dim s As Inventor.Sheet = a.ActiveSheet


Dim i As Integer = 1
For Each b As Inventor.DrawingDimension In s.DrawingDimensions
	i=i+1
	GoExcel.CellValue("C:\TEMP\DrawingDimensions.xlsx", "Sheet1", "A" & i) = b.Text.Text.ToString
	GoExcel.Save

	Next

[bradeneuropeArthur]

forgot the SAVE!

[eladm]

Hi

Ok , it takes the dimension , great , but I also need the tolerance ( only some of the dimension)

I must have dimension with tolerance to excel

regards

[bradeneuropeArthur · Accepted solution]

Dim a As Inventor.DrawingDocument = ThisDrawing.Document
Dim s As Inventor.Sheet = a.ActiveSheet


Dim i As Integer = 1
For Each b As Inventor.DrawingDimension In s.DrawingDimensions
	i = i + 1
	'MsgBox (b.Tolerance.Upper)
	GoExcel.CellValue("C:\TEMP\DrawingDimensions.xlsx", "Sheet1", "A" & i) = b.Text.Text.ToString
	GoExcel.CellValue("B" & i) = b.Tolerance.Upper
	GoExcel.CellValue("C" & i) = b.Tolerance.Lower
	GoExcel.Save

	Next

[bradeneuropeArthur · Accepted solution]

And with a Heading will be your next question:

Dim a As Inventor.DrawingDocument = ThisDrawing.Document
Dim s As Inventor.Sheet = a.ActiveSheet


Dim i As Integer = 1
For Each b As Inventor.DrawingDimension In s.DrawingDimensions
	i = i + 1
	
	GoExcel.CellValue("C:\TEMP\DrawingDimensions.xlsx", "Sheet1", "A" & i) = b.Text.Text.ToString
	GoExcel.CellValue("B" & i) = b.Tolerance.Upper
	GoExcel.CellValue("C" & i) = b.Tolerance.Lower
	
	GoExcel.CellValue("A" & 1) = "Dimension"
	GoExcel.CellValue("B" & 1) = "Tolerance Upper"
	GoExcel.CellValue("C" & 1) = "Tolerance Lower"
	GoExcel.Save

	Next

[eladm]

Hi

The next question is the name of the excel with the name of the file 🙂

but ,See the problems

1)dim with symmetric

 2)and extra 0

[bradeneuropeArthur]

AddReference "Microsoft.Office.Interop.Excel.dll"
Imports exe = Microsoft.Office.Interop.Excel

Dim oXLFile As String = "C:\TEMP\DrawingDimensions.xlsx"
Dim oSheet As String = "Sheet1"

Dim oExcel As New Microsoft.Office.Interop.Excel.ApplicationClass
Dim oWB As Microsoft.Office.Interop.Excel.Workbook = oExcel.Workbooks.Open(oXLFile)
Dim oWS As Microsoft.Office.Interop.Excel.Worksheet = oWB.Worksheets.Item(oSheet)

Dim oCells As Microsoft.Office.Interop.Excel.Range = oWS.Cells

oCells.item(2,1).value= "sjgjsagjlk"'b.Text.Text.ToString

Dim a As Inventor.DrawingDocument = ThisDrawing.Document
Dim s As Inventor.Sheet = a.ActiveSheet


Dim i As Integer = 1
For Each b As Inventor.DrawingDimension In s.DrawingDimensions
	i = i + 1
'	'MsgBox (b.Tolerance.Upper)
	
oCells.item(i,1).value = b.Text.Text.ToString
oCells.item(i,2).value = b.Tolerance.Upper
oCells.item(i,3).value  = b.Tolerance.Lower
	
oCells.item(1,1).value  = "Dimension"
oCells.item(1,2).value = "Tolerance Upper"
oCells.item(1,3).value = "Tolerance Lower"
'	GoExcel.Save()

	Next
	oWB.saveas("C:\TEMP\"& a.DisplayName & ".xlsx")
oWB.close
	

[eladm]

Hi

The tolerance is divided by 10

for example : 100+0.2 = the result is 0.02

[bradeneuropeArthur]

We are coming closer:

AddReference "Microsoft.Office.Interop.Excel.dll"
Imports exe = Microsoft.Office.Interop.Excel

Dim oXLFile As String = "C:\TEMP\DrawingDimensions.xlsx"
Dim oSheet As String = "Sheet1"

Dim oExcel As New Microsoft.Office.Interop.Excel.ApplicationClass
Dim oWB As Microsoft.Office.Interop.Excel.Workbook = oExcel.Workbooks.Open(oXLFile)
Dim oWS As Microsoft.Office.Interop.Excel.Worksheet = oWB.Worksheets.Item(oSheet)

Dim oCells As Microsoft.Office.Interop.Excel.Range = oWS.Cells

oCells.item(2,1).value= "sjgjsagjlk"'b.Text.Text.ToString

Dim a As Inventor.DrawingDocument = ThisDrawing.Document
Dim s As Inventor.Sheet = a.ActiveSheet


Dim i As Integer = 1
For Each b As Inventor.DrawingDimension In s.DrawingDimensions
	i = i + 1
'	'MsgBox (b.Tolerance.Upper)
	
oCells.item(i,1).value = b.Text.Text.ToString
oCells.item(i,2).value = b.Tolerance.Upper*10
oCells.item(i,3).value  = b.Tolerance.Lower*10
	
oCells.item(1,1).value  = "Dimension"
oCells.item(1,2).value = "Tolerance Upper"
oCells.item(1,3).value = "Tolerance Lower"
'	GoExcel.Save()

	Next
	oWB.saveas("C:\TEMP\"& a.DisplayName & ".xlsx")
oWB.close
	

[eladm]

you do most of the job 🙂

why we need this : 

Dim oXLFile As String = "C:\TEMP\DrawingDimensions.xlsx" 

[bradeneuropeArthur]

That is the template!

[bradeneuropeArthur]

AddReference "Microsoft.Office.Interop.Excel.dll"
Imports exe = Microsoft.Office.Interop.Excel

'Dim oXLFile As String = "C:\TEMP\DrawingDimensions.xlsx"
Dim oSheet As String = "Sheet1"

Dim oExcel As New Microsoft.Office.Interop.Excel.ApplicationClass
Dim oWB As Microsoft.Office.Interop.Excel.Workbook = oExcel.Workbooks.add
Dim oWS As Microsoft.Office.Interop.Excel.Worksheet = oWB.Worksheets.Item(oSheet)

Dim oCells As Microsoft.Office.Interop.Excel.Range = oWS.Cells

Dim a As Inventor.DrawingDocument = ThisDrawing.Document
Dim s As Inventor.Sheet = a.ActiveSheet

Dim i As Integer = 1
For Each b As Inventor.DrawingDimension In s.DrawingDimensions
	i = i + 1
'	'MsgBox (b.Tolerance.Upper)
	
oCells.item(i,1).value = b.Text.Text.ToString
oCells.item(i,2).value = b.Tolerance.Upper*10
oCells.item(i,3).value  = b.Tolerance.Lower*10
	
oCells.item(1,1).value  = "Dimension"
oCells.item(1,2).value = "Tolerance Upper"
oCells.item(1,3).value = "Tolerance Lower"
'	GoExcel.Save()

	Next
	oWB.saveas("C:\TEMP\"& a.DisplayName & ".xlsx")
oWB.close
	

Without template use this:

[eladm]

The symmetric still make problem

[eladm]

Hi 

Can you fix the code ? It not export the symmetric tolerance value for min. and max. , only one of them

best regards

[bradeneuropeArthur · Accepted solution]

Sure:

AddReference "Microsoft.Office.Interop.Excel.dll"
Imports exe = Microsoft.Office.Interop.Excel

'Dim oXLFile As String = "C:\TEMP\DrawingDimensions.xlsx"
Dim oSheet As String = "Sheet1"

Dim oExcel As New Microsoft.Office.Interop.Excel.ApplicationClass
Dim oWB As Microsoft.Office.Interop.Excel.Workbook = oExcel.Workbooks.add'.Open(oXLFile)
Dim oWS As Microsoft.Office.Interop.Excel.Worksheet = oWB.Worksheets.Item(oSheet)

Dim oCells As Microsoft.Office.Interop.Excel.Range = oWS.Cells

'oCells.item(2,1).value= b.Text.Text.ToString

Dim a As Inventor.DrawingDocument = ThisDrawing.Document
Dim s As Inventor.Sheet = a.ActiveSheet


Dim i As Integer = 1
For Each b As Inventor.DrawingDimension In s.DrawingDimensions
	i = i + 1
'MsgBox (b.Text.Text & " " & b.Tolerance.ToleranceType)
	
	If b.Tolerance.ToleranceType = 31236 Then
		oCells.item(i,1).value = b.Text.Text
		oCells.item(i,2).value = b.Tolerance.Upper*10
		oCells.item(i,3).value  = b.Tolerance.Lower*10
	
		oCells.item(1,1).value  = "Dimension"
		oCells.item(1,2).value = "Tolerance Upper"
		oCells.item(1,3).value = "Tolerance Lower"
		End If
If b.Tolerance.ToleranceType = 31233 Then
		oCells.item(i,1).value = b.Text.Text
		oCells.item(i,2).value = b.Tolerance.Upper*10
		oCells.item(i,3).value  = b.Tolerance.Lower*10
	
		oCells.item(1,1).value  = "Dimension"
		oCells.item(1,2).value = "Tolerance Upper"
		oCells.item(1,3).value = "Tolerance Lower"
		End If
If b.Tolerance.ToleranceType = 31235 Then
		oCells.item(i,1).value = b.Text.Text
		oCells.item(i,2).value = "+/-" & b.Tolerance.Upper*10
		'oCells.item(i,3).value  = "+/-" &b.Tolerance.Lower*10.ToString
	
		oCells.item(1,1).value  = "Dimension"
		oCells.item(1,2).value = "Tolerance Upper"
		oCells.item(1,3).value = "Tolerance Lower"
		End If


	Next
	oWB.saveas("C:\TEMP\"& a.DisplayName & ".xlsx")
oWB.close