Extracting points coordinates form a sketch using VBA to excel

[jeeva.scientist]

Hello everyone,

• I have created a sketch with constriction lines and placed some points, on the sketch as a guide path.
• I want to extract the coordinates of all points and export to excel. (Using VBA iLogic)
• Points are created using sketch points.
• I just want to extract the coordinates for sketch points that created manually. (not for line endpoints and arc endpoints)
• I have attached the sketch image for reference, thanks in advance.

[frederic.vandenplas]

'VBA CODE add a reference to microsoft excel xx.0 Object library
Sub ExportSketchPoints()

Dim oExcelApp As Excel.Application
Set oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = True
Dim wb As Excel.Workbook
Set wb = oExcelApp.Workbooks.Add
Dim osheet As WorkSheet
Set osheet = wb.Sheets(1)
    
Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.ActiveDocument

Dim oPartCompDef As PartComponentDefinition
Set oPartCompDef = oPartDoc.ComponentDefinition

'Get the first sketch in the model
Dim oSketch As Sketch
Set oSketch = oPartCompDef.Sketches.Item(1)

Dim oSketchPoint As SketchPoint

Dim x As Integer
x = 1
osheet.Cells(x, 1).Value = "x"
osheet.Cells(x, 2).Value = "y"

x = 2
For Each oSketchPoint In oSketch.SketchPoints

'Values in cm
osheet.Cells(x, 1).Value = oSketchPoint.Geometry.x
osheet.Cells(x, 2).Value = oSketchPoint.Geometry.Y

x = x + 1
Next

End Sub

'ILOGIC CODE
AddReference "Microsoft.Office.Interop.Excel" 'To use excel

Dim oExcelApp As Microsoft.Office.Interop.Excel.Application
oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = True
Dim wb As Microsoft.Office.Interop.Excel.WorkBook 
xlwb = oExcelApp.Workbooks.Add
Dim xlws As Microsoft.Office.Interop.Excel.Worksheet
xlws = xlwb.Worksheets(1)
    
Dim oPartDoc As PartDocument
oPartDoc = ThisApplication.ActiveDocument

Dim oPartCompDef As PartComponentDefinition
oPartCompDef = oPartDoc.ComponentDefinition

'Get the first sketch in the model
Dim oSketch As Sketch
oSketch = oPartCompDef.Sketches.Item(1)

Dim oSketchPoint As SketchPoint

Dim x As Integer
x = 1
xlws.Cells(x, 1).Value = "x"
xlws.Cells(x, 2).Value = "y"

x = 2
For Each oSketchPoint In oSketch.SketchPoints

'Values in cm
xlws.Cells(x, 1).Value = oSketchPoint.Geometry.x
xlws.Cells(x, 2).Value = oSketchPoint.Geometry.Y

x = x + 1
Next

[jeeva.scientist]

hello,

Thanks for your response, I used the iLogic code its works. but it is also considering the other points such us

• circle center point,
• projected origin point,
• and also endpoints of a line.

is there a way to extract only the sketch points that are created manually. (ie. excluding the above-mentioned points).

as you mentioned it is in "cm" in excel. is there a way to get it in "mm".

thanks, again for the support.

I have attached the image for further reference.

[frederic.vandenplas]

Hi,

There are different approaches possible, below 2 possibilities, the one uncommented is best i think

conversion is commented

For Each oSketchPoint In oSketch.SketchPoints
'If oSketchPoint.HoleCenter = True Then
If oSketchPoint.AttachedEntities.Count = 0 Then
'Values in cm by default , multiply by 10 to get mm (other approaches possibly with UOM conversion)
osheet.Cells(x, 1).Value = oSketchPoint.Geometry.x * 10
osheet.Cells(x, 2).Value = oSketchPoint.Geometry.Y * 10
x = x + 1
End If
Next oSketchPoint

[jeeva.scientist]

Sorry, I am totally new to VBA.?

I have added your second code to the first code.

The unit is converted to mm, its a success.

but the center point and line endpoints are still there.

'ILOGIC CODE
AddReference "Microsoft.Office.Interop.Excel" 'To use excel

Dim oExcelApp As Microsoft.Office.Interop.Excel.Application
oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = True
Dim wb As Microsoft.Office.Interop.Excel.WorkBook 
xlwb = oExcelApp.Workbooks.Add
Dim xlws As Microsoft.Office.Interop.Excel.Worksheet
xlws = xlwb.Worksheets(1)
    
Dim oPartDoc As PartDocument
oPartDoc = ThisApplication.ActiveDocument

Dim oPartCompDef As PartComponentDefinition
oPartCompDef = oPartDoc.ComponentDefinition

'Get the first sketch in the model
Dim oSketch As Sketch
oSketch = oPartCompDef.Sketches.Item(1)

Dim oSketchPoint As SketchPoint

Dim x As Integer
x = 1
xlws.Cells(x, 1).Value = "x"
xlws.Cells(x, 2).Value = "y"

x = 2
For Each oSketchPoint In oSketch.SketchPoints
If oSketchPoint.AttachedEntities.Count = 0 Then '2nd code
End If
'Values in cm
xlws.Cells(x, 1).Value = oSketchPoint.Geometry.x * 10 '2nd code
xlws.Cells(x, 2).Value = oSketchPoint.Geometry.Y * 10 '2nd code

x = x + 1
Next

The reason I am trying to solve this is that I could not solve my other problem. if it's ok please take a look at this too, thanks.

https://forums.autodesk.com/t5/inventor-customization/creation-sketch-with-vba-ilogic/m-p/8998899#M1...

[frederic.vandenplas]

'this
For Each oSketchPoint In oSketch.SketchPoints
If oSketchPoint.AttachedEntities.Count = 0 Then '2nd code
End If
'Values in cm
xlws.Cells(x, 1).Value = oSketchPoint.Geometry.x * 10 '2nd code
xlws.Cells(x, 2).Value = oSketchPoint.Geometry.Y * 10 '2nd code

x = x + 1
Next

'should be
For Each oSketchPoint In oSketch.SketchPoints
If oSketchPoint.AttachedEntities.Count = 0 Then '2nd code
'Values in cm
xlws.Cells(x, 1).Value = oSketchPoint.Geometry.x * 10 '2nd code
xlws.Cells(x, 2).Value = oSketchPoint.Geometry.Y * 10 '2nd code
x = x + 1
End If
Next

[jeeva.scientist]

Hello, please check I don't know whether I have added correctly or not. I excel output i got 2 extra rows.

kindly find the part file attachment.

'ILOGIC CODE
AddReference "Microsoft.Office.Interop.Excel" 'To use excel

Dim oExcelApp As Microsoft.Office.Interop.Excel.Application
oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = True
Dim wb As Microsoft.Office.Interop.Excel.WorkBook 
xlwb = oExcelApp.Workbooks.Add
Dim xlws As Microsoft.Office.Interop.Excel.Worksheet
xlws = xlwb.Worksheets(1)
    
Dim oPartDoc As PartDocument
oPartDoc = ThisApplication.ActiveDocument

Dim oPartCompDef As PartComponentDefinition
oPartCompDef = oPartDoc.ComponentDefinition

'Get the first sketch in the model
Dim oSketch As Sketch
oSketch = oPartCompDef.Sketches.Item(1)
Dim oSketchPoint As SketchPoint
Dim x As Integer
x = 1
xlws.Cells(x, 1).Value = "x"
xlws.Cells(x, 2).Value = "y"

'this
For Each oSketchPoint In oSketch.SketchPoints
If oSketchPoint.AttachedEntities.Count = 0 Then '2nd code
End If
'Values in cm
xlws.Cells(x, 1).Value = oSketchPoint.Geometry.x * 10 '2nd code
xlws.Cells(x, 2).Value = oSketchPoint.Geometry.Y * 10 '2nd code
x = x + 1
Next
'should be
For Each oSketchPoint In oSketch.SketchPoints
If oSketchPoint.AttachedEntities.Count = 0 Then '2nd code
'Values in cm
xlws.Cells(x, 1).Value = oSketchPoint.Geometry.x * 10 '2nd code
xlws.Cells(x, 2).Value = oSketchPoint.Geometry.Y * 10 '2nd code
x = x + 1
End If
Next

[jeeva.scientist]

I am wondering what if I use work point instead of sketch point. wouldn't it be easy to find the coordinates? if its a work point. if it's easy to find the works point coordinates and export it to excel its enough for me.

in the above image, you can see that I have created work points in two different methods.

• using a circular pattern.
• using a rectangular pattern.

Output Expecting:

• Count: total number of work points.
• Coordinates of all work point exported to excel.

thanks.

[frederic.vandenplas · Accepted solution]

So you let me create code for a problem, i've created working code and now you change your question?

Anyway here you go 😀

'VBA CODE add a reference to microsoft excel xx.0 Object library
Sub ExportSketchPoints()

Dim oExcelApp As Excel.Application
Set oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = True
Dim wb As Excel.Workbook
Set wb = oExcelApp.Workbooks.Add
Dim osheet As WorkSheet
Set osheet = wb.Sheets(1)
    
Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.ActiveDocument

Dim oPartCompDef As PartComponentDefinition
Set oPartCompDef = oPartDoc.ComponentDefinition

Dim oWorkPoint As WorkPoint

Dim x As Integer
x = 1
osheet.Cells(x, 1).Value = "x"
osheet.Cells(x, 2).Value = "y"
osheet.Cells(x, 3).Value = "z"
x = 2
For Each oWorkPoint In oPartCompDef.WorkPoints
osheet.Cells(x, 1).Value = oWorkPoint.Point.x * 10
osheet.Cells(x, 2).Value = oWorkPoint.Point.Y * 10
osheet.Cells(x, 3).Value = oWorkPoint.Point.z * 10
x = x + 1
Next oWorkPoint

End Sub

[jeeva.scientist]

I am getting this error,

[frederic.vandenplas · Accepted solution]

You did not add the reference to miscrosoft excel library

https://www.google.com/search?q=add+reference+vba&rlz=1C1GCEU_nlBE824BE824&oq=add+reference+vba&aqs=...

[jeeva.scientist]

Thanks bro. it works perfectly. working proof.