Jump to content

XYZ coordinate data export


enemigoman

Recommended Posts

You can try the following VBA application. It displays the coordinates of all 3DPolylines selected by the user in Excel.

 

 

 

Sub Export3DPolylines()

 

Dim objSS As AcadSelectionSet

On Error Resume Next

ThisDrawing.SelectionSets("MySS").Delete

ThisDrawing.SelectionSets.Add ("MySS")

Set objSS = ThisDrawing.SelectionSets("MySS")

objSS.SelectOnScreen

 

Dim objent As AcadEntity

Dim MasRem() As AcadEntity

Dim N As Integer

N = -1

 

For Each objent In objSS

If objent.ObjectName "AcDb3dPolyline" Then

N = N + 1

If N = 0 Then

ReDim MasRem(N)

Else

ReDim Preserve MasRem(N)

End If

Set MasRem(N) = objent

End If

Next

 

objSS.RemoveItems MasRem

 

If objSS.Count = 0 Then

MsgBox "No 3DPolylines found!"

Exit Sub

End If

 

Dim Excel As Object

Set Excel = CreateObject("Excel.Application")

Set wkb = Excel.workbooks.Add

Set sht = wkb.sheets(1)

 

Dim MasCoord As Variant

Dim Col As Integer

Dim Row As Integer

Col = -3

Row = 1

 

For i = 0 To objSS.Count - 1

Col = Col + 4

Row = 1

MasCoord = objSS(i).Coordinates

 

sht.cells(1, Col) = "3DPolyline " & i + 1 & " coordinates"

sht.cells(2, Col) = "X"

sht.cells(2, Col + 1) = "Y"

sht.cells(2, Col + 2) = "Z"

Row = 2

For j = 0 To (UBound(MasCoord) + 1) / 3 - 1

Row = Row + 1

sht.cells(Row, Col) = MasCoord(3 * j)

sht.cells(Row, Col + 1) = MasCoord(3 * j + 1)

sht.cells(Row, Col + 2) = MasCoord(3 * j + 2)

Next

Next

 

Excel.Visible = True

 

End Sub

Link to comment
Share on other sites

and this is for exporting polyline points into text or csv files to open them in excel. Note thet you can edit the program text tochange the separator. You may use \t to have the items separated by a tab, \n to have them on a new line or use any other symbol.

;export old style polyline vertex coords to a text file
;    [email="mfuccaro@hotmail.com"]mfuccaro@hotmail.com[/email]
(defun c:pl2tx( / en ask i a file)
 (while (not ask)
   (setq en (car (entsel)))
   (if en (setq ask (= "POLYLINE" (cdr (assoc 0 (entget en))))))
   )
 (setq file (open (getfiled "Output file"
                (strcat (getvar "dwgprefix")
                (substr (getvar "DWGNAME") 1 (- (strlen (getvar "dwgname")) 4)))
                "txt"     ;file type
                1) "w"))
 (setq i 0 sep ";")    ;sep=separator
 (while (or (zerop i) a)
   (setq a (mapcar 'rtos (cdr (assoc 10 (entget (setq en (entnext en)))))))
   (if a (write-line (strcat (car a) sep (cadr a) sep (caddr a)) file))
   (setq i (1+ i))
   )
 (close file)
 (princ (strcat "\n" (itoa (1- i)) " points exported"))
 (princ)
 )

And HERE you will find help on how to run Lisp routines.

Link to comment
Share on other sites

  • 3 years later...

Hey... a few years later I found this post.

 

I ran the vba from Joro thanks it works really good except that...

 

Id really like to have alle the coordinate in the first 3 row. The code does export the coordinate of each polyline in different set of 3 row.

 

I tried to modified the code with no sucess. I tried to change col = col +4 to col = col but it didnt work.

 

I no nothing about coding.

 

If someonw can help it will save me a lot of time.

 

Thanks

Link to comment
Share on other sites

  • 8 years later...

Hello,

Any one can help me. i am working a small company. client need to export data from autocad 2016  ( Sl NO, X ,Y, X ,ID) in CSV or EXcel. 

some one please help me. 

Thank you.

Link to comment
Share on other sites

Did you read the posts all the answers are there. Also a Autocad point does not have ( Sl NO, X ,Y, X ,ID) the ID in particular. 

 

Are you talking abouting CIV3D very different answers.

Link to comment
Share on other sites

  • 1 month later...

Good Afternoon,

 

With the help from "HowToAutoCAD.com" I was able to modify the script below. The script works fine, but when the points gets exported to CSV they are written in random order. I would like to have the points listed in numerical order from lowest to highest. My understanding is that I first need to use an array to list the points and then sort the points and then export the points out to CSV. But, I really do not know setup an array and then sort the points. Is it possible for someone to help me with this?

 

Option Explicit

Sub ExportPoints()
    Dim currentSelectionSet As AcadSelectionSet
    Dim ent As AcadEntity
    Dim pnt As AeccPoint
    Dim csvFile As String
    Dim FSO As FileSystemObject
    Dim textFile As TextStream
    


    Set currentSelectionSet = Thisdrawing.ActiveSelectionSet
        
    If currentSelectionSet.Count = 0 Then
        Thisdrawing.Utility.Prompt "There are no currently selected objects. Please select some points to export, and run this command again." & vbNewLine
    End If
        csvFile = csvFile & "POINT NO." & "," & "EASTING" & "," & "NORTHING" & "," & "ELEVATION" & "," & "FEATURE CODE" & vbNewLine
    
    For Each ent In currentSelectionSet
        
        If TypeOf ent Is AeccPoint Then
         
         Set pnt = ent
         
         csvFile = csvFile & pnt.Number & "," & Round(pnt.Easting, 3) & "," & Round(pnt.Northing, 3) & "," & Round(pnt.Elevation, 3) & "," & pnt.Description & vbNewLine
     
        End If
    
    Next
 
    
    Set FSO = New FileSystemObject
    Set textFile = FSO.CreateTextFile((Left(Thisdrawing.Name, Len(Thisdrawing.Name) - 4)) & ".csv")
    textFile.Write csvFile
    textFile.Close
   

    Thisdrawing.Utility.Prompt "Points were exported to the same folder as this drawing." & vbNewLine
 
 
End Sub

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...