Visual Basic Customization

Visual Basic Customization

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

Export Line Coordinates

665 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 (651 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

 

Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Announcements
Do you have 60 seconds to spare? The Autodesk Community Team is revamping our site ranking system and we want your feedback! Please click here to launch the 5 question survey. As always your input is greatly appreciated.