CADForums.net

supreme · Guest

hello everybody,
can anybody can suggest how i can get the diffrent polylines from the drawing based on layer (filtering out only required layer) and get the length of polylines (those filtered out) in excel format
susan

Paul · Guest

Susan,

If want to use excel there is a sample
in the AutoCAD VBA sample folder called
"ExcelLink".

The sample I wrote is nice for simple soulutions
and you don't need excel on the machine your
working on.

Only finds single segment LWPolys on current layer,
and exports Handle and Length to a .csv file which
can be opened directly in Excel.

Needs some work but might be helpful as a start.

gl,
Paul

'<code>
Option Explicit

Sub export()
Dim pline As AcadLWPolyline
Dim startPT(2) As Double
Dim endPT(2) As Double
Dim csvFile As Integer: csvFile = FreeFile
Dim dwgPath As String

dwgPath = ThisDrawing.Path & "\" & "Output.csv"

'Will append to existing file or create new
Open dwgPath For Append As #csvFile

'Add header
Print #csvFile, "Handle" & "," & "Length"
'Add blank Row
Print #csvFile, ","

For Each pline In ThisDrawing.ModelSpace
If pline.Layer = ThisDrawing.ActiveLayer.Name _
And UBound(pline.Coordinates) = 3 Then

startPT(0) = pline.Coordinates(0)
startPT(1) = pline.Coordinates(1)
startPT(2) = 0 'added for function
endPT(0) = pline.Coordinates(2)
endPT(1) = pline.Coordinates(3)
endPT(2) = 0 'added for function
'Send data to next availible line
Print #csvFile, pline.Handle & "," & _
plineLength(startPT, endPT)

End If
Next pline

Close #csvFile

End Sub
Public Function plineLength(p1 As Variant, p2 As Variant) As Double
plineLength = VBA.Sqr((p2(2) - p1(2)) * (p2(2) - p1(2)) + _
(p2(1) - p1(1)) * (p2(1) - p1(1)) _
+ (p2(0) - p1(0)) * (p2(0) - p1(0)))
End Function
'</code>

"supreme" <nospam@address.withheld> wrote in message
news:32918488.1109431682873.JavaMail.jive@jiveforum2.autodesk.com...

albud1962 · Guest

Paul,

I tried this code and I can't seem to get it to work for me.

Paul Richardson · Guest

what is happening?
"albud1962" <nospam@address.withheld> wrote in message
news:9744867.1110948099291.JavaMail.jive@jiveforum2.autodesk.com...

Paul Richardson · Guest

try this...I could have taken time to write the other version
a bit better. save the drawing your using and place at least
one lwpoly in the drawing. will only find single segment
lwpoly.

Option Explicit

Sub csvExport()
Dim pline As AcadLWPolyline
Dim genObj As AcadObject
Dim startPT(2) As Double
Dim endPT(2) As Double
Dim csvFile As Integer: csvFile = FreeFile
Dim dwgPath As String

dwgPath = ThisDrawing.Path & "\" & "Output.csv"

'Will append to existing file or create new
Open dwgPath For Append As #csvFile

'Add header
Print #csvFile, "Handle" & "," & "Length"
'Add blank Row
Print #csvFile, ","

For Each genObj In ThisDrawing.ModelSpace

If TypeOf genObj Is AcadLWPolyline Then

Set pline = genObj

If pline.Layer = ThisDrawing.ActiveLayer.Name _
And UBound(pline.Coordinates) = 3 Then

startPT(0) = pline.Coordinates(0)
startPT(1) = pline.Coordinates(1)
startPT(2) = 0 'added for function
endPT(0) = pline.Coordinates(2)
endPT(1) = pline.Coordinates(3)
endPT(2) = 0 'added for function
'Send data to next availible line
Print #csvFile, pline.Handle & "," & _
plineLength(startPT, endPT)

End If

End If

Next genObj

Close #csvFile

End Sub
Public Function plineLength(p1 As Variant, p2 As Variant) As Double
plineLength = VBA.Sqr((p2(2) - p1(2)) * (p2(2) - p1(2)) + _
(p2(1) - p1(1)) * (p2(1) - p1(1)) _
+ (p2(0) - p1(0)) * (p2(0) - p1(0)))
End Function
"albud1962" <nospam@address.withheld> wrote in message
news:9744867.1110948099291.JavaMail.jive@jiveforum2.autodesk.com...

albud1962 · Guest

Oh, I had multisegment plines.

Paul Richardson · Guest

add whatever ya need....good luck..
"albud1962" <nospam@address.withheld> wrote in message
news:21494135.1111031553075.JavaMail.jive@jiveforum1.autodesk.com...
> Oh, I had multisegment plines.

	CADForums.net Forum Index -> VBA	All times are GMT
Page 1 of 1