Export user selected line endpoints to excel

[Anonymous]

Hi,

I have an Excel VBA script that takes the mass properties from an active drawing and does various things with them.

What I would like to do is have the script prompt the user to select a line in AutoCAD and then export the end points to my Excel file (or to a text file that I can then read into excel).

I've had a look at the forums but couldn't find anything on this but feel free to direct me to another post if this has already been done.

I'm new to VBA and AutoCAD generally so please keep your answers idiot proof!

Thanks!

[Ed__Jobe · Accepted solution]

Hi Tom,

Sorry I don't have time to write code at the moment, but here are the steps and you can search the forum for code on each step.

search for code on exporting to xl. It will show you how to create an app opbject and work with sheets, cells. Don't forget to set to Nothing, any xl variable objects that you create. Do so in reverse order that you created them.

dim startpoint as variant 'will be a 3-element array, x,y,z

dim endpoint as variant

Create a selectionset with a filter for line entities

iterate the selectionset with 

   For Each lineEnt in ss

       startpoint = lineEnt.StartPoint

       endpoint = lineEnt.EndPoint

       set xl cell a1 to startpoint(0)

       set xl cell b1 to startpoint(1)

       set xl cell c1 to endpoint(0)

       set xl cell d1 to endpoint(1)

   next

Also, since you are new to acad vba, there are a lot of code samples available in Help. Go to the Object Browser and select an item, then click on the yellow question mark.

[Anonymous]

Hi, thanks for your help, I managed to get it to work from VBA in AutoCAD using what you said.

Here's the code for anyone else looking to do the same thing:

Sub ExportLineCoords()

Dim SS As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets("MySS").Delete
ThisDrawing.SelectionSets.Add ("MySS")
Set SS = ThisDrawing.SelectionSets("MySS")
SS.SelectOnScreen

Dim Excel As Object
Set Excel = CreateObject("Excel.Application")
Set wkb = Excel.workbooks.Add
Set sht = wkb.sheets(1)

Dim startpoint As Variant
Dim endpoint As Variant
Dim Row As Integer

sht.cells(1, 1) = "Line coordinates"
sht.cells(2, 1) = "X"
sht.cells(2, 2) = "Y"
sht.cells(2, 3) = "Z"

Row = 1

For Each lineEnt In SS

Row = Row + 2

startpoint = lineEnt.startpoint
endpoint = lineEnt.endpoint

sht.cells(Row, 1) = startpoint(0)
sht.cells(Row, 2) = startpoint(1)
sht.cells(Row, 3) = startpoint(2)

Row = Row + 1

sht.cells(Row, 1) = endpoint(0)
sht.cells(Row, 2) = endpoint(1)
sht.cells(Row, 3) = endpoint(2)

Next

Excel.Visible = True

End Sub

I'll try to convert it to work from Excel VBA next and then post that on here.

Thanks!

Tom

[Ed__Jobe]

Glad you got it working. Notice that VBA autocorrect didn't correctly capitalize the names as LineEnt.StartPoint and LineEnt.EntPoint. It is all in lowercase because you've named your variables the same name and dimensioned them in lowercase. You've got a naming conflict. Rename your variables and vba will fix the method names.

[Anonymous]

Hi, thanks for your help - I've put my Excel VBA code below for anyone interested. Would I be able to adapt this code so that the user could select an area using the area command and put this in Excel?

Sub ExportLineCoords

AppActivate "Autodesk AutoCAD"

Dim SS As AcadSelectionSet
On Error Resume Next
ACAD.ActiveDocument.SelectionSets("MySS").Delete
ACAD.ActiveDocument.SelectionSets.Add ("MySS")
Set SS = ACAD.ActiveDocument.SelectionSets("MySS")
SS.SelectOnScreen

Dim SPoint As Variant
Dim EPoint As Variant
Dim Row As Integer
Dim Num As Integer

Cells(3, 35) = "Line coordinates"
Cells(4, 35) = "X"
Cells(4, 36) = "Y"
Cells(4, 37) = "Z"
Cells(1, 35) = "Number of lines:"

Row = 3
Num = 0

For Each LineEnt In SS

Row = Row + 2
Num = Num + 1

SPoint = LineEnt.StartPoint
EPoint = LineEnt.EndPoint

Cells(Row, 35) = SPoint(0)
Cells(Row, 36) = SPoint(1)
Cells(Row, 37) = SPoint(2)

Row = Row + 1

Cells(Row, 35) = EPoint(0)
Cells(Row, 36) = EPoint(1)
Cells(Row, 37) = EPoint(2)

Next

Cells(1, 37) = Num

AppActivate "Excel"

End Sub