LineStart and LineEnd to excel

LineStart and LineEnd to excel

Anonymous
Not applicable
835 Views
10 Replies
Message 1 of 11

LineStart and LineEnd to excel

Anonymous
Not applicable
Hello everyone,

I´m creating a VBA application in Excel that takes objects from AutoCAD and places it´s properties in an Excel sheet. (With the properties from this sheet i want to create a SVG file.)
Writing layer, color, handle, name and text to excel works beautifully using the acax17enu.tlb library. example:

Dim ent As AcadEntity
Dim Excel As Object
Dim excelSheet As Object
Dim entLayer As String
entLayer = ""
entLayer = ent.Layer
excelSheet.Cells(R, 1).Value = entLayer

and voila the layer is in column A

I also neet Start and Endpoint of a line or path of a polyline and center of circles etc. For now I use the Getpoint function to acquire these points:

dim startpoint as variant
dim x as double,y as double,z as double
StartPoint = ThisDrawing.Utility.GetPoint(Prompt:="Pick Insert Point:")
x=startpoint(0)
y=startpoint(1)
z=startpoint(2)

excelSheet.Cells(R, 7).Value = x
excelSheet.Cells(R, 8).Value = y

the function requires you to interactively select the points rather than automatically selecting startpoint and endpoint. Is there another way to do this?
Are these points in another library maybe?
Or can I get the Getpoint function to automatically select certain points?

Thanks!
0 Likes
836 Views
10 Replies
Replies (10)
Message 2 of 11

Anonymous
Not applicable
You could simply loop through ModelSpace looking for targeted entities by,
say, entity type (AcadLine, acadCircle, AcadBlockreference...) and get the
needed information. Example code:

Dim ent AS AcadEntity
Dim l as String
Dim p as Variant

For Each ent in ThisDrawing.ModelSpace
l=ent.Layer
excelSheet.Cells(...).Value=l

If TypeOf ent Is AcadLine Then
'You know Line by AcadLine.StartPoint and AcadLine.EndPoint
'Then add the point/property value to Excel Sheet
ElseIf TypeOf ent Is AcadCircle Then
'You get center point of the Circle: AcadCircle.Center
...
ElseIf TypeOf ent Is....
....
Else
...
End Id

Next

Of course if you only are interested in certain type of entity and if the
drawing is big, you could easily use SelectionSet with proper filter to get
targeting entities a lot faster than looping through whole MS.


wrote in message news:5789164@discussion.autodesk.com...
Hello everyone,

I´m creating a VBA application in Excel that takes objects from AutoCAD and
places it´s properties in an Excel sheet. (With the properties from this
sheet i want to create a SVG file.)
Writing layer, color, handle, name and text to excel works beautifully using
the acax17enu.tlb library. example:

Dim ent As AcadEntity
Dim Excel As Object
Dim excelSheet As Object
Dim entLayer As String
entLayer = ""
entLayer = ent.Layer
excelSheet.Cells(R, 1).Value = entLayer

and voila the layer is in column A

I also neet Start and Endpoint of a line or path of a polyline and center of
circles etc. For now I use the Getpoint function to acquire these points:

dim startpoint as variant
dim x as double,y as double,z as double
StartPoint = ThisDrawing.Utility.GetPoint(Prompt:="Pick Insert Point:")
x=startpoint(0)
y=startpoint(1)
z=startpoint(2)

excelSheet.Cells(R, 7).Value = x
excelSheet.Cells(R, 8).Value = y

the function requires you to interactively select the points rather than
automatically selecting startpoint and endpoint. Is there another way to do
this?
Are these points in another library maybe?
Or can I get the Getpoint function to automatically select certain points?

Thanks!
0 Likes
Message 3 of 11

Anonymous
Not applicable
thnx for your input, i'll try this monday and reply
0 Likes
Message 4 of 11

Anonymous
Not applicable
Still can't get it to work. First of all AcadLine.StartPoint and AcadLine.Endpoint are not recognized but AcadLine.Start and AcadLine.End are. i've build in a messagebox to check them but they do not have a value...

Dim p1 as Variant
Dim p2 as Variant

For Each ent In SSET2

p1 = AcadLine.Start
p2 = AcadLine.End

MsgBox p1
MsgBox p2

'excelSheet.Cells(R, 11).Value = p1
'excelSheet.Cells(R, 12).Value = p2

what am i doing wrong?
0 Likes
Message 5 of 11

Anonymous
Not applicable
I do not know whcih Acad you use, but AcadLine has property StartPoint and
EndPoint, whcih is variant type (double array). So, you cannot MsbBox p1.

The code would look like:

Dim l as AcadLine
For Each ent in SSET2
If TypeOf ent Is AcadLine Then
Set l=ent
MsgBox "Start X=" & i.StartPoint(0) & vbCr & Start Y=" &
l.StartPoint(1) & vbCr & "Start Z=" & I.StartPoint(2)
'Update Sheet here
End If
Next

wrote in message news:5790529@discussion.autodesk.com...
Still can't get it to work. First of all AcadLine.StartPoint and
AcadLine.Endpoint are not recognized but AcadLine.Start and AcadLine.End
are. i've build in a messagebox to check them but they do not have a
value...

Dim p1 as Variant
Dim p2 as Variant

For Each ent In SSET2

p1 = AcadLine.Start
p2 = AcadLine.End

MsgBox p1
MsgBox p2

'excelSheet.Cells(R, 11).Value = p1
'excelSheet.Cells(R, 12).Value = p2

what am i doing wrong?
0 Likes
Message 6 of 11

Anonymous
Not applicable
i've spend all afternoon trying to figure out why my StartPoint etc are not accepted. I can find them in my objectlist but can't add them to my code. i'm using acad 2008
0 Likes
Message 7 of 11

Anonymous
Not applicable
Although I do not have acad2008 installed, but I think it ( AcadLine's
StartPoint/EndPoint properties) is still there (if not, Autodesk will be
buried in flood of angry rants).

Probably you mean the intellisense does not show StartPoint/EndPoint when
you type code in VBA IDE. That is because

either

You have wrong code in previous lines. You could do compile to dig it out;

Or

If you have code like you showed in previous code, it, of course, should not
show the intellisense prompt, because you did not cast AcadEntity into
AcadLine entity. It should look like:

Dim l as AcadLine
...
For Each ent In SSET2

If TypeOf ent Is AcadLine Then
Set l=ent '''Only after this line, you can have
StartPoint/EndPoint shown in intellisence prompt.
p1 = l.StartPoint
p2 = l.EndPoint
End If
MsgBox p1
MsgBox p2
...
Next

Since I do not have Acad2008, I am only 99.9999% positive AcadLine stiil
have StartPoint/EndPoint properties (if not I would quit doing anything with
Acad at all), in the case (0.00001% chance) that StartPoint/EndPoint not
exist any more, then sorry, you have do your own study on Acad2008 VBA.


wrote in message news:5790775@discussion.autodesk.com...
i've spend all afternoon trying to figure out why my StartPoint etc are not
accepted. I can find them in my objectlist but can't add them to my code.
i'm using acad 2008
0 Likes
Message 8 of 11

Anonymous
Not applicable
Trust me, these properties are still there. 🙂

"Norman Yuan" wrote in message
news:5791252@discussion.autodesk.com...
Although I do not have acad2008 installed, but I think it ( AcadLine's
StartPoint/EndPoint properties) is still there (if not, Autodesk will be
buried in flood of angry rants).
0 Likes
Message 9 of 11

Anonymous
Not applicable
FINALLY! It works! Norman thanks a bunch!

This is my final code for extracting linecoordinates to excel, for anyone who's interested.

Sub AutoCADEntities()
Dim AutoCAD As acadapplication
Dim Thisdrawing As AcadDocument 'as Object
Dim activedocument As Object
Dim SSET2 As Object
Dim Excel As Object
Dim excelSheet As Object
Dim application As Object
Dim c As Integer, R As Integer
Dim Line As AcadLine
Dim startpunt As Variant
Dim eindpunt As Variant
Dim x2 As Double, y2 As Double, z2 As Double
Dim x As Double, y As Double, z As Double

On Error Resume Next

'get excel if app already open
Set Excel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
'create/open excel if not
Set Excel = CreateObject("Excel.Application")
'handle excel error if app cannot be opened.
If Err <> 0 Then
MsgBox "Could not load Excel.", vbExclamation
End
End If
End If
Excel.Visible = True
'add a new work book
'Excel.Workbooks.Add
'select Worksheet named "Sheet1"
Excel.Sheets("Sheet1").Select

Set excelSheet = Excel.ActiveWorkbook.Sheets("Sheet1")

' I do this a couple of times, because ocassionally, in my projects, the first attempt fails
Set acadapp = GetObject(, "autocad.application")
Set Thisdrawing = acadapp.activedocument
Set acadapp = GetObject(, "AutoCAD.Application")
Set Thisdrawing = acadapp.activedocument

Apptivate
' = sub for activating the autocad window you want to use

Set SSET2 = Thisdrawing.SelectionSets.Add("strSet3")

R = 1
SSET2.SelectOnScreen

AppActivate ("Microsoft Excel")

For Each ent In SSET2
If TypeOf ent Is AcadLine Then
Set Line = ent
startpunt = Line.startpoint
eindpunt = Line.endpoint
x = startpunt(0)
x2 = eindpunt(0)
y = startpunt(1)
y2 = eindpunt(1)
End If

excelSheet.Cells(R, 1).Value = x
excelSheet.Cells(R, 2).Value = x2
excelSheet.Cells(R, 7).Value = y
excelSheet.Cells(R, 8).Value = y2
R = R + 1
Next ent

good luck
0 Likes
Message 10 of 11

Anonymous
Not applicable
RickVE wrote:
> FINALLY! It works! Norman thanks a bunch!
>
> This is my final code for extracting linecoordinates to excel, for anyone who's interested.
>
> Sub AutoCADEntities()
> Dim AutoCAD As acadapplication
> Dim Thisdrawing As AcadDocument 'as Object
> Dim activedocument As Object
> Dim SSET2 As Object
> Dim Excel As Object
> Dim excelSheet As Object
> Dim application As Object
> Dim c As Integer, R As Integer
> Dim Line As AcadLine
> Dim startpunt As Variant
> Dim eindpunt As Variant
> Dim x2 As Double, y2 As Double, z2 As Double
> Dim x As Double, y As Double, z As Double
>
> On Error Resume Next
>
> 'get excel if app already open
> Set Excel = GetObject(, "Excel.Application")
> If Err <> 0 Then
> Err.Clear
> 'create/open excel if not
> Set Excel = CreateObject("Excel.Application")
> 'handle excel error if app cannot be opened.
> If Err <> 0 Then
> MsgBox "Could not load Excel.", vbExclamation
> End
> End If
> End If
> Excel.Visible = True
> 'add a new work book
> 'Excel.Workbooks.Add
> 'select Worksheet named "Sheet1"
> Excel.Sheets("Sheet1").Select
>
> Set excelSheet = Excel.ActiveWorkbook.Sheets("Sheet1")
>
> ' I do this a couple of times, because ocassionally, in my projects, the first attempt fails
> Set acadapp = GetObject(, "autocad.application")
> Set Thisdrawing = acadapp.activedocument
> Set acadapp = GetObject(, "AutoCAD.Application")
> Set Thisdrawing = acadapp.activedocument
>
> Apptivate
> ' = sub for activating the autocad window you want to use
>
> Set SSET2 = Thisdrawing.SelectionSets.Add("strSet3")
>
> R = 1
> SSET2.SelectOnScreen
>
> AppActivate ("Microsoft Excel")
>
> For Each ent In SSET2
> If TypeOf ent Is AcadLine Then
> Set Line = ent
> startpunt = Line.startpoint
> eindpunt = Line.endpoint
> x = startpunt(0)
> x2 = eindpunt(0)
> y = startpunt(1)
> y2 = eindpunt(1)
> End If
>
> excelSheet.Cells(R, 1).Value = x
> excelSheet.Cells(R, 2).Value = x2
> excelSheet.Cells(R, 7).Value = y
> excelSheet.Cells(R, 8).Value = y2
> R = R + 1
> Next ent
>
> good luck

Instead of testing to see if it's a line within the loop:
>If TypeOf ent Is AcadLine Then

Use filters on your selection set to select only lines.
It's much quicker. Always keep your loops to the minimum possible. There are numerous example on the web.

Dave F.
0 Likes
Message 11 of 11

Anonymous
Not applicable
Sorry, Rick
I'll don't recommend the similar code to
somebody else
This looks ugly for me
If you want to write it in the good manner,
please take a look at this page for example:

http://www.excelguru.ca/node/10

~'J'~
0 Likes