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

[eladm]

Hi 

Can the code not will be :

The desire :

[bradeneuropeArthur]

Sure hang on!

[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'.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

[eladm]

sorry , the min value is zero

[bradeneuropeArthur · Accepted solution]

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.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

[eladm]

same result

[_dscholtes_]

@bradeneuropeArthur Why are you setting the column headers with each dimension?

[bradeneuropeArthur · Accepted solution]

Modified:

Heading

and the minus sign added.

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
		oCells.item(1,1).value  = "Dimension"
		oCells.item(1,2).value = "Tolerance Upper"
		oCells.item(1,3).value = "Tolerance Lower"
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
	

		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

		End If
If b.Tolerance.ToleranceType = 31235 Then
	Dim du As Double = "+" & (b.Tolerance.Upper * 10)
	Dim dl As Double = "-" & (b.Tolerance.Upper * 10)
	'MsgBox("+"&(b.Tolerance.Upper*10).ToString)
		oCells.item(i,1).value = b.Text.Text
		oCells.item(i,2).value = du '"="+"" &(b.Tolerance.Upper*10)'"p"'"+" & b.Tolerance.Upper*10
		oCells.item(i,3).value  = dl'"-" &(b.Tolerance.Lower*10)'"q"'"-" &b.Tolerance.Lower*10

		End If


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

[eladm]

Hello

This is great , but why it not detect ref. / basic / limit dimension ?

[bradeneuropeArthur · Accepted solution]

Try this.

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
		oCells.item(1,1).value  = "Dimension"
		oCells.item(1,2).value = "Tolerance Upper"
		oCells.item(1,3).value = "Tolerance Lower"
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
	

		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

		End If
If b.Tolerance.ToleranceType = 31235 Then
	Dim du As Double = "+" & (b.Tolerance.Upper * 10)
	Dim dl As Double = "-" & (b.Tolerance.Upper * 10)
	'MsgBox("+"&(b.Tolerance.Upper*10).ToString)
		oCells.item(i,1).value = b.Text.Text
		oCells.item(i,2).value = du '"="+"" &(b.Tolerance.Upper*10)'"p"'"+" & b.Tolerance.Upper*10
		oCells.item(i,3).value  = dl'"-" &(b.Tolerance.Lower*10)'"q"'"-" &b.Tolerance.Lower*10

		End If
If b.Tolerance.ToleranceType = 31246 Then
		oCells.item(i,1).value = (Replace((Replace(b.Text.Text.ToString,"(","")),")",""))'Replace(b.Text.Text.ToString,"-","")
		oCells.item(i,2).value = b.Tolerance.Upper*10
		oCells.item(i,3).value  = b.Tolerance.Lower*10

		End If

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

[eladm]

thank you very much

[eladm]

Hello

Do you know , why instead to get the diameter symbol , the excel get the letter n ?

regards

[chuck.bardsley]

Is there a way to do this for ordinate dimensions.  Where each dim would export as X,Y?

[bradeneuropeArthur]

You mean if horizontal then there is an x dimension
and if vertical there is an Y dimension?

[chuck.bardsley]

---

@bradeneuropeArthur wrote:
You mean if horizontal then there is an x dimension
and if vertical there is an Y dimension?

---

That is correct