Export Line Coordinates

[Anonymous]

Hi everyone,

I hope you can help me, I have been struggiling with this problem for quite some weeks now. I would like to use VBA to do the following.

Export the coordinates for all lines and polylines on a pre defined layer to a text file. the format being...

X, Y
X, Y
X, Y

X, Y

I really hope someone could help me.

Regards,

Dan.

[mendesva]

Hi, try this. Certanly not the best way to do it but it works...

Sub test()

    ExportLines ("LAYERNAME")

End Sub

Function ExportLines(layerName As String)

    Dim fType() As Integer, fData()

    Dim sset As AcadSelectionSet

    Dim acObject As AcadObject

    Dim i As Integer

    'filename to export to

    Dim expFilename As String

    expFilename = "d:\temp\autocad\ExportLines.txt"

    'get the next free file identifier

    Dim fnum As Variant

    fnum = FreeFile()

    'open the filename

    Open expFilename For Output As fnum

    On Error Resume Next

    'try to create a new selectionset

    'if it exists, delete it and recreate a new one

    Set sset = thisdrawing.SelectionSets("sset")

    If Err Then Set sset = thisdrawing.SelectionSets.Add("sset")

    'if it exists, erase it's content

    sset.Clear

    'filter lines and polyline in a given layer

    ReDim fType(7), fData(7)

    fType(0) = -4: fData(0) = "<and"

    fType(1) = -4: fData(1) = "<or"

    fType(2) = 0: fData(2) = "LINE"

    fType(3) = 0: fData(3) = "LWPOLYLINE"

    fType(4) = -4: fData(4) = "or>"

    fType(5) = 8: fData(5) = layerName

    fType(6) = 67: fData(6) = "0" 'modelspace=0 paperspace=1

    fType(7) = -4: fData(7) = "and>"

    On Error GoTo Crashed

    'get selectionset

    sset.Select acSelectionSetAll, , , fType, fData

    'prompt how many objects were found

    thisdrawing.Utility.Prompt (vbCrLf & "Exporting " & sset.Count & " Lines and Polylines")

    'go throu all objects in selectionset

    Dim objLine As AcadLine, objPolyline As AcadLWPolyline

    For Each acObject In sset

        If TypeName(acObject) = "IAcadLine2" Then

            Set objLine = acObject

            'write to file

            Write #fnum, "X=" & objLine.StartPoint(0) & ", " & _

                "Y=" & objLine.StartPoint(1) & ", " & "Z=" & objLine.StartPoint(2)

        Else

            Set objPolyline = acObject

            Dim plCoord As Integer

            'build string with Polyline coordinates to export

            Dim expCoordinates As String

            expCoordinates = ""

            'print points

            For i = 0 To UBound(objPolyline.Coordinates) Step 2

                expCoordinates = expCoordinates & "X=" & objPolyline.Coordinates(i) & ", " & _

                "Y=" & objPolyline.Coordinates(i + 1) & ", "

            Next i

            'write to file

            Write #fnum, expCoordinates & "Z=" & objPolyline.Elevation & ", Closed=" & objPolyline.Closed

        End If

      Next acObject

Crashed:

    'close file

    Close #fnum

    'clear selectionset

    sset.Clear

End Function

[brice1977]

Hi there,

Is that a lisp routine ? it doesn't load for me....