Jump to content

AutoLisp to extract TEXT and Coordinates


Recommended Posts

ktbjx

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 post
Share on other sites
Steven P

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 post
Share on other sites
ktbjx
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

Link to post
Share on other sites
BIGAL

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 1
Link to post
Share on other sites
ktbjx
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 post
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 post
Share on other sites
Jonathan Handojo
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 post
Share on other sites
BIGAL

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