Text co-ordinates export to csv

[AbdRF]

Hi all,

I need help with exporting texts co-ordinates, rotation and values/contents to the excel csv.
Mostly all the texts are in one or two layers.

I am aware of a data extraction command, but it is very time-consuming and has many steps which are not required by me.
I want text coordinates, rotation and values/contents as a column of csv file

Can somebody help me with this?
Thanks

 

[Emmanuel Delay]

I agree.  Data extract is too time-consuming, it's nicer to have something custom built.

 

I add a column LAYER.  Then you can use your spreadsheet program to filter/sort on layer, if that's okay.

 

Command ET

 

;; @FILE export texts.  contents, insert point, layer

(vl-load-com)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Exporting to csv

;; http://www.lee-mac.com/writecsv.html

;; Write CSV  -  Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - [lst] list of lists, sublist is row of cell values
;; csv - [str] filename of CSV file to write
;; Returns T if successful, else nil
(defun LM:WriteCSV ( lst csv / des sep )
    (if (setq des (open csv "w"))
        (progn
            (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
            (foreach row lst (write-line (LM:lst->csv row sep) des))
            (close des)
            t
        )
    )
)

;; List -> CSV  -  Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token
(defun LM:lst->csv ( lst sep )
    (if (cdr lst)
        (strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
        (LM:csv-addquotes (car lst) sep)
    )
)

(defun LM:csv-addquotes ( str sep / pos )
    (cond
        (   (wcmatch str (strcat "*[`" sep "\"]*"))
            (setq pos 0)    
            (while (setq pos (vl-string-position 34 str pos))
                (setq str (vl-string-subst "\"\"" "\"" str pos)
                      pos (+ pos 2)
                )
            )
            (strcat "\"" str "\"")
        )
        (   str   )
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Command ET, for Extract Text
(defun c:ET ( / ss i rows ent filepath)
 
  ;; Select the text objects
  (setq ss (ssget "X" '((0 . "TEXT") )))
 
    ;;;; Or maybe you also want MTEXT, then you uncomment this next line
    ;;;; notice: Mtext encodes "new line" as "\P", and may also contain code for style (like color, bold...)
    ;; (setq ss (ssget "X" '((0 . "TEXT,MTEXT") )))
    
  ;; the head (column titles) of the CSV.  You coule leave this blank, like this: (setq rows (list))
  (setq rows (list (list "LAYER" "X" "Y" "ROTATION" "TEXT")))
 
  ;; read the data, put it in a list (in variable rows)
  (setq i 0)
  (repeat (sslength ss)
    
    (setq ent (entget (ssname ss i)))  ;; extract the properties
    
    ;; add the data to rows
    (setq rows (append rows (list (list
      (cdr (assoc 8 ent))                                   ;; Layer
      (rtos (nth 0 (cdr (assoc 10 ent))) 2 16)              ;; X value, notice: numbers must be converted to text, that's what the rtos does.  Feel free to change the precision (the 16)
      (rtos (nth 1 (cdr (assoc 10 ent))) 2 16)              ;; Y value
      (rtos (/ (* (cdr (assoc 50 ent)) 180) pi ) 2 16)      ;; rotation  - ("angle in rad" * 180 / pi) = angle in 360 degrees
      (cdr (assoc 1 ent))                                   ;; Text contents
    ))))
    
    (setq i (+ i 1))
  )
 
  ;; we'll save the file in the same path, and same file name as the dwg, except with extension .csv
  ;; (make sure the drawing is saved somewhere, and make sure that location is writable)
  (setq filepath (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".csv"))
 
 
  ;; save to csv
  (if
    (LM:WriteCSV rows filepath)
    (progn (princ "\nSaved as: ") (princ  filepath))
    (progn (princ "\nSomething went wrong"))
  )
 
  (princ)
 
)

[AbdRF]

@Emmanuel Delay

Thank u very much for your effort and time.
I would like to request you that I am interested in the text details on certain layers only and not in the whole dwg file.
Mostly my required texts are in one or two layers (the layer name is different for different dwgs)
I can merge these layer into one layer.
Can you modify the code so that it asks the user for the layer or simply window selection of the texts whose details are to be exported?
Thanks


 

[Emmanuel Delay]

Okay, you can type the layer, or layers now.

comma separated, for example Layer1   or   Layer1,Layer2

 

;; @FILE export texts.  contents, insert point, layer

(vl-load-com)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Exporting to csv

;; http://www.lee-mac.com/writecsv.html

;; Write CSV  -  Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - [lst] list of lists, sublist is row of cell values
;; csv - [str] filename of CSV file to write
;; Returns T if successful, else nil
(defun LM:WriteCSV ( lst csv / des sep )
    (if (setq des (open csv "w"))
        (progn
            (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
            (foreach row lst (write-line (LM:lst->csv row sep) des))
            (close des)
            t
        )
    )
)

;; List -> CSV  -  Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token
(defun LM:lst->csv ( lst sep )
    (if (cdr lst)
        (strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
        (LM:csv-addquotes (car lst) sep)
    )
)

(defun LM:csv-addquotes ( str sep / pos )
    (cond
        (   (wcmatch str (strcat "*[`" sep "\"]*"))
            (setq pos 0)    
            (while (setq pos (vl-string-position 34 str pos))
                (setq str (vl-string-subst "\"\"" "\"" str pos)
                      pos (+ pos 2)
                )
            )
            (strcat "\"" str "\"")
        )
        (   str   )
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Command ET, for Extract Text
(defun c:ET ( / ss i rows ent filepath layers)
 
  ;; Select the text objects
 
  (setq layers (getstring "\nLayers to extract, example Layer1,Layer2 : "))
  (setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 layers) )))
 
    ;;;; Or maybe you also want MTEXT, then you replace "TEXT" with "TEXT,MTEXT"
    ;;;; notice: Mtext encodes "new line" as "\P", and may also contain code for style (like color, bold...)

  ;; the head (column titles) of the CSV.  You coule leave this blank, like this: (setq rows (list))
  (setq rows (list (list "LAYER" "X" "Y" "ROTATION" "TEXT")))
 
  ;; read the data, put it in a list (in variable rows)
  (setq i 0)
  (repeat (sslength ss)
    
    (setq ent (entget (ssname ss i)))  ;; extract the properties
    
    ;; add the data to rows
    (setq rows (append rows (list (list
      (cdr (assoc 8 ent))                                   ;; Layer
      (rtos (nth 0 (cdr (assoc 10 ent))) 2 16)              ;; X value, notice: numbers must be converted to text, that's what the rtos does.  Feel free to change the precision (the 16)
      (rtos (nth 1 (cdr (assoc 10 ent))) 2 16)              ;; Y value
      (rtos (/ (* (cdr (assoc 50 ent)) 180) pi ) 2 16)      ;; rotation  - ("angle in rad" * 180 / pi) = angle in 360 degrees
      (cdr (assoc 1 ent))                                   ;; Text contents
    ))))
    
    (setq i (+ i 1))
  )
 
  ;; we'll save the file in the same path, and same file name as the dwg, except with extension .csv
  ;; (make sure the drawing is saved somewhere, and make sure that location is writable)
  (setq filepath (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".csv"))
 
 
  ;; save to csv
  (if
    (LM:WriteCSV rows filepath)
    (progn (princ "\nSaved as: ") (princ  filepath))
    (progn (princ "\nSomething went wrong"))
  )
 
  (princ)
 
)

 

[Emmanuel Delay]

You can also do this, then you select the text objects

 

instead of this:

 

(setq layers (getstring "\nLayers to extract, example Layer1,Layer2 : "))
(setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 layers) )))
 

do this

(setq ss (ssget (list (cons 0 "TEXT") )))

 

[AbdRF]

@Emmanuel Delay

Thanks bro. It is working amazingly 

 

[CADWORKER]

On 4/29/2019 at 2:51 PM, Emmanuel Delay said:

You can also do this, then you select the text objects

 

instead of this:

 

(setq layers (getstring "\nLayers to extract, example Layer1,Layer2 : "))
(setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 layers) )))
 

do this

(setq ss (ssget (list (cons 0 "TEXT") )))

 

Hi Emmanuel,

Can we get the Elevation of the text along with the details?

Also if the csv is sortex in the order Text value, Easting, Northing, Elevation and Layer

 

Thanking you in advance

[BIGAL]

You should be able to work this out as you have numerous posts now. 

 

do this


(setq ss (ssget (list (cons 0 "TEXT")(cons 410 (getvar 'ctab)))))

 

So just make a list (text X Y Z) just get each item in the ss look at DXF 1 and DXF 10. Or VL textstring and insertionpoint

Then use 

(setq lst (vl-sort lst '(lambda ( a b ) (< (car a) (car b)))))

 

Then just write a csv file.