Jump to content

AutoLisp to extract TEXT and Coordinates

ktbjx

By ktbjx
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

ktbjx Community Regular

ktbjx

Posted
Posted

is this possible?

i have this dwg full of texts and Mtexts,

and i need to get the text values and coordinates, thats it!

problem with "dataextraction" command is the text have this random letters and numbers into it. so i have to remove it and retain just the Values.

so its a bit time consuming on my part.

if there is an easier or faster way. It would be so much help!

mhupp Grand Master

mhupp

Posted
Posted

If they where blocks it would be easier but sounds like they are not.

ktbjx Community Regular

ktbjx

Posted
  • Author
Posted
15 hours ago, Trudy said:

Can you attach dwg file :)

 

Sorry for the very late reply,
here it is sir... all i need is the text contents and coordinates

sample.dwg

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Try this, note you will need to change the name of the output file to a directory that exists, it can be changed to say save to same location as dwg.

 

  

(vl-load-com)

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

(defun c:t2csv ( / ss fname obj objstr txtins x )
(setq ss (ssget '((0 . "*TEXT"))))
(if (/= ss nil)
  (progn
    (setq fname (open "D:\\acadtemp\\text2csv.txt" "W"))
    (repeat (setq x (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
      (setq objstr (vla-get-textstring  obj))
      (setq txtins (vlax-get obj 'InsertionPoint))
      (if (= (vla-get-objectname obj) "AcDbMText")
       (setq objstr (LM:UnFormat objstr nil))
      )
      (setq objstr (strcat (rtos (car txtins) 2 3) "," (rtos (cadr txtins) 2 3) "," (rtos (caddr txtins) 2 3) "," objstr))
      (write-line objstr fname)
	  (princ (strcat "\n" (rtos x 2 0)))
    )
    (close fname)
  )
  (alert "No text selected try again")
)
(princ)
)

 

Edited by BIGAL
  • Like 2
ktbjx Community Regular

ktbjx

Posted
  • Author
Posted
1 hour ago, BIGAL said:

Try this, note you will need to change the name of the output file to a directory that exists, it can be changed to say save to same location as dwg.

 

  


(vl-load-com)

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

(defun c:t2csv ( / ss fname obj objstr txtins x )
(setq ss (ssget '((0 . "*TEXT"))))
(if (/= ss nil)
  (progn
    (setq fname (open "D:\\acadtemp\\text2csv.txt" "W"))
    (repeat (setq x (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
      (setq objstr (vla-get-textstring  obj))
      (setq txtins (vlax-get obj 'InsertionPoint))
      (if (= (vla-get-objectname obj) "AcDbMText")
       (setq objstr (LM:UnFormat objstr nil))
      )
      (setq objstr (strcat (rtos (car txtins) 2 3) "," (rtos (cadr txtins) 2 3) "," (rtos (caddr txtins) 2 3) "," objstr))
      (write-line objstr fname)
	  (princ (strcat "\n" (rtos x 2 0)))
    )
    (close fname)
  )
  (alert "No text selected try again")
)
(princ)
)

 

 

 

YES! just what i need! thank you sir! this is a big help

  • Like 1
Ish Community Regular

Ish

Posted
Posted (edited)
On 4/29/2021 at 7:01 AM, BIGAL said:

Try this, note you will need to change the name of the output file to a directory that exists, it can be changed to say save to same location as dwg.

 

  



(vl-load-com)

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

(defun c:t2csv ( / ss fname obj objstr txtins x )
(setq ss (ssget '((0 . "*TEXT"))))
(if (/= ss nil)
  (progn
    (setq fname (open "D:\\acadtemp\\text2csv.txt" "W"))
    (repeat (setq x (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
      (setq objstr (vla-get-textstring  obj))
      (setq txtins (vlax-get obj 'InsertionPoint))
      (if (= (vla-get-objectname obj) "AcDbMText")
       (setq objstr (LM:UnFormat objstr nil))
      )
      (setq objstr (strcat (rtos (car txtins) 2 3) "," (rtos (cadr txtins) 2 3) "," (rtos (caddr txtins) 2 3) "," objstr))
      (write-line objstr fname)
	  (princ (strcat "\n" (rtos x 2 0)))
    )
    (close fname)
  )
  (alert "No text selected try again")
)
(princ)
)

 

In this program possible that we can select text one by one or all in AutoCAD and export to CSV.

after that we change text in CSV then draw text in AutoCAD ,

remove or replace old text and draw the change text at  same location.

 

Any other lisp program for That.

 

Thanks 

Edited by Ish
Modified
Jonathan Handojo Experienced

Jonathan Handojo

Posted
Posted
9 hours ago, Ish said:

In this program possible that we can select text one by one or all in AutoCAD and export to CSV.

after that we change text in CSV then draw text in AutoCAD ,

remove or replace old text and draw the change text at  same location.

 

Any other lisp program for That.

 

Thanks 

 

If only fields in AutoCAD can reference texts from tables... been a lingering problem for ages, otherwise I would have:

 

1. Used the provided to create the CSV

2. Inserted a table somewhere on AutoCAD, and use a data link to link the created CSV file to the table.

3. Used a field to reference the text from the table in that specific cell.

 

So when you change the text on the CSV file, save the CSV, reload the link in CAD, and you'll see the change.

 

Even though the above is not applicable, it's still not entirely impossible. At the worst case, you might just use reactors, but it's a tedious process. For someone who seems to only demand for free codes and -8 community reputation, you need to realize that the kind of "code" you're requesting for is not something a few simple lines can solve for you. Sooner or later someone might just charge you money for it.

  • Like 1
BIGAL Grand Master

BIGAL

Posted
Posted

Sooner or later someone might just charge you money for it.

 

The way to go is write direct to Excel change it there and then reupdate very possible.

 

Why dont you have a go write the csv with *Text handle use that to update text.

  • Like 1
Ish Community Regular

Ish

Posted
Posted
30 minutes ago, BIGAL said:

Sooner or later someone might just charge you money for it.

 

The way to go is write direct to Excel change it there and then reupdate very possible.

 

Why dont you have a go write the csv with *Text handle use that to update text.

Text already written in AutoCAD,

  • 7 months later...
BangVD Rookie

BangVD

Posted
Posted
On 29/4/2021 at 08:31, BIGAL said:

Hãy thử điều này, lưu ý rằng bạn sẽ cần phải thay đổi tên của tệp đầu ra thành một thư mục tồn tại, nó có thể được thay đổi để nói lưu vào cùng vị trí với dwg.

 

 

 

sir i changed output directory       (setq fname (open "C:\Users\BangVD\Desktop\text2csv.txt" "W"))

but it gives error :bad argument type: streamp nil

Steven P Grand Master

Steven P

Posted
Posted
3 hours ago, BangVD said:

sir i changed output directory       (setq fname (open "C:\Users\BangVD\Desktop\text2csv.txt" "W"))

but it gives error :bad argument type: streamp nil

 

You'll need to use \\ instead of single \

"C:\\Users\\BangVD\\Desktop\\text2csv.txt"

 

'\' is a control character, meaning the next character does special stuff, if you just use 1 of them it might interpret the file path something 'c : [Underline] sers [Bold] angVD .......' rather than c:\users\bangvd.....  Double \\ means tells the LISP to read the character as a single \

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.

×
 Share
Go to topic listing
×
×
  • Create New...