Export attribute to txt (litle help with my block)

I find this code lisp in the forum

(defun c:att2file ()
 (setq File1 (getfiled "File name" "" "txt" 1))
 (setq Fopen (open File1 "w"))
 (princ "\nSelect blocks to write att coords: ")
 (setq BlockSet (ssget '((0 . "INSERT") (66 . 1))))
 (setq Ecount 0)
 (repeat (sslength BlockSet)
    (setq Bname (ssname BlockSet Ecount))
    (setq Blabel (cdr (assoc 2 (entget Bname))))
    (setq AttName (entnext Bname))
    (setq AttData (entget AttName))
    (setq TxtIns (cdr (assoc 10 AttData)))
    (setq Xtxt (rtos (car TxtIns) 2 4))
    (setq ytxt (rtos (cadr TxtIns) 2 4))
    (setq XY_Txt (strcat Blabel " " xtxt "," ytxt))
    (write-line XY_Txt Fopen)
    (setq Ecount (1+ Ecount))
 )
 (close Fopen)
 (princ)
)

when i export the coordinates gives me a txt file like this

point 72.2175,182.0613

point 72.1467,183.9717

point 71.9343,189.0662

point 71.0847,191.8257

point 63.6504,196.7786

point 53.4548,194.9390

The problem is that i need a file

1,72.1467,183.9717

2,71.9343,189.0662

s1,71.0847,191.8257

T1,63.6504,196.7786

K1,53.4548,194.9390

.

.

.

..

here is my block.

Is this possible ?

Thanks

Point.dwg

Just remove the highlighted codes from the routine if you are satisfied with the routine .

I find this code lisp in the forum

 

    [color=red](setq Blabel (cdr (assoc 2 (entget Bname))))[/color]
    ..
...
....
    (setq XY_Txt (strcat [color=red]Blabel[/color] " " xtxt "," ytxt))
    

 

I remove them Tharwat but now the results is not P,X,Y but only X,Y. I need P,X,Y .

(defun c:att2file ()
 (setq File1 (getfiled "File name" "" "txt" 1))
 (setq Fopen (open File1 "w"))
 (princ "\nSelect blocks to write att coords: ")
 (setq BlockSet (ssget '((0 . "INSERT") (66 . 1))))
 (setq Ecount 0)
 (repeat (sslength BlockSet)
    (setq Bname (ssname BlockSet Ecount))
    (setq AttName (entnext Bname))
    (setq AttData (entget AttName))
    (setq TxtIns (cdr (assoc 10 AttData)))
    (setq Xtxt (rtos (car TxtIns) 2 4))
    (setq ytxt (rtos (cadr TxtIns) 2 4))
    (setq XY_Txt (strcat " " xtxt "," ytxt))
    (write-line XY_Txt Fopen)
    (setq Ecount (1+ Ecount))
 )
 (close Fopen)
 (princ)
)

I find that, the coordinates is not correct !! any ideas

What do you mean by P ,X,Y ?

P, The number of the point , 1,2,3,k1,s1,t1 anything

Here is an example of my points.

I better to update the export as

P,X,Y,Z

1, 58.262 ,191.538 ,100

.

.

.

S1,80.776,194.665,99.23

.

.

.

TEST.dwg

Try this new routine ..

(defun c:Test (/ f ss o i n sn pt e p)
 ;;     Tharwat 11.08.2013    ;;
 (if (and (setq f (getfiled "File name" "" "txt" 1))
          (setq ss (ssget '((0 . "INSERT") (66 . 1))))
          (setq o (open f "w"))
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq n  (entnext (setq sn (ssname ss (setq i (1- i)))))
             pt (cdr (assoc 10 (entget sn)))
       )
       (while (not (eq (cdr (assoc 0 (setq e (entget n)))) "SEQEND"))
         (if (and (eq (cdr (assoc 0 e)) "ATTRIB")
                  (eq (strcase (cdr (assoc 2 e))) "POINT")
             )
           (setq p (cdr (assoc 1 e)))
         )
         (setq n (entnext n))
       )
       (if p
         (write-line
           (strcat p
                   ","
                   (rtos (car pt) 2)
                   ","
                   (rtos (cadr pt) 2)
                   ","
                   (rtos (caddr pt) 2)
           )
           o
         )
       )
     )
     (close o)
   )
 )
 (princ)
)

Thar****,

Could you make a similar but different Lisp for an export with the description as well and have it use Point#, Northing (Y), Easting (X), Elevation (Z) and Description? [P,N,E,Z,D]

Thanks,

Ed

Thar****,

Why is that ?

I don't know why it did that? I had typed your name in full as Tharwat.

I would try to work my way through the lisp but don't have a resource with the point variables.

Thanks,

Ed

Here is a generic, all-purpose block export program:

;; My Export  -  Lee Mac
;; A generic data extraction program for attributed blocks.
;; 
;; The 'ord' list can contain attribute tags or symbols representing block
;; insertion coordinates.
;; 
;; e.g. ("TAG1" POINT-Y POINT-X "TAG2")
;; 
;; will extract the value of attribute 'TAG1', followed by the Y & X-coordinates
;; of the block insertion point, followed by the value of attribute 'TAG2'.
;; 
;; Point values will be formatted using the current values of the LUNITS & LUPREC
;; system variables.
;;
;; The filename, extension & data delimiter character are all specified at the
;; top of the program code.

(defun c:myexport ( / *error* del des ent idx lst obj ord out sel )

   (defun *error* ( msg )
       (if (= 'file (type des))
           (close des)
       )
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )

   (setq ord '("TAG1" POINT-X POINT-Y POINT-Z "TAG2")
         out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".txt")
         del  "\t"
   )
   (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
       (if (setq des (open out "w"))
           (progn
               (repeat (setq idx (sslength sel))
                   (setq ent (ssname sel (setq idx (1- idx)))
                         obj (vlax-ename->vla-object ent)
                   )
                   (setq lst
                       (append
                           (mapcar '(lambda ( a b ) (cons a (rtos b)))
                              '(point-x point-y point-z)
                               (trans (cdr (assoc 10 (entget ent))) ent 0)
                           )
                           (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
                               (append
                                   (vlax-invoke obj 'getattributes)
                                   (vlax-invoke obj 'getconstantattributes)
                               )
                           )
                       )
                   )
                   (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
                       (write-line (LM:lst->str lst del) des)
                   )
               )
               (setq des (close des))
           )
           (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
       )
   )
   (princ)
)

;; List to String  -  Lee Mac
;; Concatenates each string in a list, separated by a given delimiter

(defun LM:lst->str ( lst del )
   (if (cdr lst)
       (strcat (car lst) del (LM:lst->str (cdr lst) del))
       (car lst)
   )
)

;; Unique Filename  -  Lee Mac
;; Returns a unique filename for a given path & file extension

(defun LM:uniquefilename ( pth ext / fnm tmp )
   (if (findfile (setq fnm (strcat pth ext)))
       (progn
           (setq tmp 1)
           (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
       )
   )
   fnm
)

(vl-load-com) (princ)

Read the commented code header for instructions for use - any questions, just ask.

Good morning Tharwat nice job.

Try this new routine ..

 

(defun c:Test (/ f ss o i n sn pt e p)
 ;;     Tharwat 11.08.2013    ;;
 (if (and (setq f (getfiled "File name" "" "txt" 1))
          (setq ss (ssget '((0 . "INSERT") (66 . 1))))
          (setq o (open f "w"))
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq n  (entnext (setq sn (ssname ss (setq i (1- i)))))
             pt (cdr (assoc 10 (entget sn)))
       )
       (while (not (eq (cdr (assoc 0 (setq e (entget n)))) "SEQEND"))
         (if (and (eq (cdr (assoc 0 e)) "ATTRIB")
                  (eq (strcase (cdr (assoc 2 e))) "POINT")
             )
           (setq p (cdr (assoc 1 e)))
         )
         (setq n (entnext n))
       )
       (if p
         (write-line
           (strcat p
                   ","
                   (rtos (car pt) 2)
                   ","
                   (rtos (cadr pt) 2)
                   ","
                   (rtos (caddr pt) 2)
           )
           o
         )
       )
     )
     (close o)
   )
 )
 (princ)
)

I check your lisp code and the results is

1,58.262,191.538,0.000

2,51.539,212.586,0.000

3,79.257,220.899,0.000

4,108.133,208.095,0.000

5,111.760,200.419,0.000

6,112.329,192.956,0.000

S1,80.776,194.665,0.000

S2,112.565,233.930,0.000

T1,44.905,234.867,0.000

K1,11.360,237.780,0.000

K2,19.483,161.843,0.000

K3,137.951,165.435,0.000

K4,136.283,249.108,0.000

can you fix the elevetion not to be 0.000

Mr Lee sorry i make some changes to the code

;; My Export  -  Lee Mac
;; A generic data extraction program for attributed blocks.
;; 
;; The 'ord' list can contain attribute tags or symbols representing block
;; insertion coordinates.
;; 
;; e.g. ("TAG1" POINT-Y POINT-X "TAG2")
;; 
;; will extract the value of attribute 'TAG1', followed by the Y & X-coordinates
;; of the block insertion point, followed by the value of attribute 'TAG2'.
;; 
;; Point values will be formatted using the current values of the LUNITS & LUPREC
;; system variables.
;;
;; The filename, extension & data delimiter character are all specified at the
;; top of the program code.

(defun c:myexport ( / *error* del des ent idx lst obj ord out sel )

   (defun *error* ( msg )
       (if (= 'file (type des))
           (close des)
       )
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )

   (setq ord '("POINT" POINT-X POINT-Y "ELEV" "DESC")
         out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".txt")
         del  "\t"
   )
   (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
       (if (setq des (open out "w"))
           (progn
               (repeat (setq idx (sslength sel))
                   (setq ent (ssname sel (setq idx (1- idx)))
                         obj (vlax-ename->vla-object ent)
                   )
                   (setq lst
                       (append
                           (mapcar '(lambda ( a b ) (cons a (rtos b)))
                              '(point-x point-y point-z)
                               (trans (cdr (assoc 10 (entget ent))) ent 0)
                           )
                           (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
                               (append
                                   (vlax-invoke obj 'getattributes)
                                   (vlax-invoke obj 'getconstantattributes)
                               )
                           )
                       )
                   )
                   (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
                       (write-line (LM:lst->str lst del) des)
                   )
               )
               (setq des (close des))
           )
           (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
       )
   )
   (princ)
)                

;; List to String  -  Lee Mac
;; Concatenates each string in a list, separated by a given delimiter

(defun LM:lst->str ( lst del )
   (if (cdr lst)
       (strcat (car lst) del (LM:lst->str (cdr lst) del))
       (car lst)
   )
)

;; Unique Filename  -  Lee Mac
;; Returns a unique filename for a given path & file extension

(defun LM:uniquefilename ( pth ext / fnm tmp )
   (if (findfile (setq fnm (strcat pth ext)))
       (progn
           (setq tmp 1)
           (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
       )
   )
   fnm
)

(vl-load-com) (princ)

the results now is PXYD (Point coord-X coord-Y ELEV DESC)

1 58.262 191.538 100

2 51.539 212.586 99.80

3 79.257 220.899 99.20

4 108.133 208.095 92.30

5 111.760 200.419 92.35

6 112.329 192.956 99.23

S1 80.776 194.665 99.23

S2 112.565 233.930 99.23

T1 44.905 234.867 99.23 tree

K1 11.360 237.780 99.23

K2 19.483 161.843 99.20

K3 137.951 165.435 99.24

K4 136.283 249.108 99.23

I need to add (,) between them not space and i want to have the option to choose the path of the txt export file is it possible. How can i do it ?

Thanks

Good morning Tharwat nice job.

Good morning to you too .

 

I check your lisp code and the results is

can you fix the elevetion not to be 0.000

It is zero because of the elevation of the insertion point of the Attributed Block .

Not taking anything away from the lisps, but look what I got using the inbuilt Attribute Extraction

and in the T1 block as posted there is no description "tree".

The Excel spreadsheet has only to be saved in .csv format, so the data has commas separating the data.

Not taking anything away from the lisps, but look what I got using the inbuilt Attribute Extraction

and in the T1 block as posted there is no description "tree".

 

The Excel spreadsheet has only to be saved in .csv format, so the data has commas separating the data.

I need to add (,) between them not space and i want to have the option to choose the path of the txt export file is it possible. How can i do it ?

I make a new draw to do the test dont stay to the numbers.Add a desc to pne point and you will see that the lisp works ....

I need to add (,) between them not space and i want to have the option to choose the path of the txt export file is it possible. How can i do it ?

Use the Attribute Extraction tool. All that you want is available there, and in this case, lisp seems to be not necessary.

I use EATTEXT but the lisp is faster.

I need to add (,) between them not space and i want to have the option to choose the path of the txt export file is it possible. How can i do it ?

And this is what the data looks like, with a column for description.

POINT,X insertion point,Y insertion point,ELEV,DESC

1,58.262,191.538,100,

2,51.539,212.586,99.8,

3,79.257,220.899,99.2,

4,108.133,208.095,92.3,

5,111.760,200.419,92.35,

6,112.329,192.956,99.23,

S1,80.776,194.665,99.23,

S2,112.565,233.930,99.23,

T1,44.905,234.867,99.23,

K1,11.360,237.780,99.23,

K2,19.483,161.843,99.2,

K3,137.951,165.435,99.24,

K4,136.283,249.108,99.23,