Visual Basic Customization

Reply
New Member
NetStorm84
Posts: 1
Registered: ‎05-10-2011
Message 1 of 2 (602 Views)

Export Line Coordinates

602 Views, 1 Replies
05-10-2011 01:04 AM

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.

Contributor
mendesva
Posts: 19
Registered: ‎04-10-2009
Message 2 of 2 (588 Views)

Re: Export Line Coordinates

05-10-2011 07:11 AM in reply to: NetStorm84

 

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

 

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community