Jump to content

AutoLisp to extract TEXT and Coordinates


ktbjx

Recommended Posts

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!

Link to comment
Share on other sites

Random text letters? From MText i am guessing which will be the formatting codes for the paragraphs. 

 

I've used this https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-text/td-p/5649883 as a starting place to find and replace text via a LISP. I don't have anything to hand that will replace selected texts but that might get you started.

 

 

Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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,

Link to comment
Share on other sites

  • 7 months later...
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

Link to comment
Share on other sites

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 \

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...