Select text from the screen and write to the textbox.

Select text from the screen and write to the textbox.

ferhatttcoskun
Enthusiast Enthusiast
1,695 Views
11 Replies
Message 1 of 12

Select text from the screen and write to the textbox.

ferhatttcoskun
Enthusiast
Enthusiast

Let the text or mtext objects I select from the screen write to texbox1.text

write next selection to textbox2

write next selection to textbox3

write next selection to textbox4

 

If I click in an empty place, it will beep.

 

if I choose another object, msgbox"please select text or mtext object"

 

I want to do like this.
Can you help me, please?

Thank you.

0 Likes
Accepted solutions (1)
1,696 Views
11 Replies
Replies (11)
Message 2 of 12

hak_vz
Advisor
Advisor

To export contents of one or multiple text (mtext) objects to a file as follows:

1) Select text and mtext objects you want to extract text

2 )Start command text2file

2) If asked for a first time it will ask for destination folder and name of text file basic string (file, textbox)

3) Contents of that text entities will be written  to "basicstring1.txt)

4) At the end it opens that file in notepad

If you select unwanted object it won't mater, and it will save you from beeps.

 

pict_out.jpg

 

pict_out_2.jpg

(defun c:text2file ( / LM:browseforfolder  inittextout f file e i ent ss ty text listout)
; Extract text or mtext object to file
; hak_vz  30.11.2019
;
(defun *error* ()
    (close file) 
    (princ)
)
(defun LM:browseforfolder ( msg dir bit / err fld pth shl slf )
;; Browse for Folder  -  Lee Mac
;; Displays a dialog prompting the user to select a folder.
;; msg - [str] message to display at top of dialog
;; dir - [str] [optional] root directory (or nil)
;; bit - [int] bit-coded flag specifying dialog display settings
;; Returns: [str] Selected folder filepath, else nil.
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "shell.application")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg bit dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              pth (vlax-get-property slf 'path)
                              pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth))
                        )
                    )
                )
            )
        )
    )
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        pth
    )
)

(defun inittextout () ;variables are globals
(setq folderout (LM:browseforfolder "Select a folder" nil 0))
(setq fileoutname (getstring "\nName of output files base >"))
(setq filecounter 0)
(princ)
)

(if (not folderout) (inittextout))

(setq filecounter (1+ filecounter))
(setq f (strcat folderout "/" fileoutname (itoa filecounter) ".txt"))
(setq file (open f "w"))
(setq ss (cadr (ssgetfirst)) i 0)
(while (< i (sslength ss))
(setq e (ssname ss i) ent (entget e))
(setq ty (strcase(cdr (assoc 0 ent)) T))
(setq text (cdr (assoc 1 ent)))
(if (= ty "mtext") 
(while (wcmatch text "*\\P*") (setq text (vl-string-subst "\n" "\\P" text)))
)    
(setq listout (cons text listout))
(setq i (1+ i))
)
(foreach e listout
    (write-line e file)
)
(close file)
(princ (strcat "\nData is writen to " f))
(startapp "notepad" f) (princ) )

I hope it works for you. If it does, set this post as a final solution.

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 3 of 12

hak_vz
Advisor
Advisor

If extracting data from a complex MTEXT object is not correct, you may temporary explode mtext object.

 

If the text string is less than 250 characters, all characters appear in group 1. If the text string is greater than 250 characters, the string is divided into 250-character chunks, which appear in one or more group 3 codes. If group 3 codes are used, the last group is a group 1 and has fewer than 250 character. Taking into account all formatting would be too complex.

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 4 of 12

hak_vz
Advisor
Advisor

Here is my final code that works OK with TEXT and MTEXT entities with strings with more than 250 characters.

(defun c:text2file ( / LM:browseforfolder  inittextout f file e i m ent ss ty text endtext  txts listout);
(vl-load-com)
; Extract text or mtext object to file
; hak_vz  30.11.2019
;
(defun *error* ()
    (close file) 
    (princ)
)

(defun LM:browseforfolder ( msg dir bit / err fld pth shl slf )
;; Browse for Folder  -  Lee Mac
;; Displays a dialog prompting the user to select a folder.
;; msg - [str] message to display at top of dialog
;; dir - [str] [optional] root directory (or nil)
;; bit - [int] bit-coded flag specifying dialog display settings
;; Returns: [str] Selected folder filepath, else nil.
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "shell.application")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg bit dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              pth (vlax-get-property slf 'path)
                              pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth))
                        )
                    )
                )
            )
        )
    )
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        pth
    )
)

(defun inittextout () ;variables are globals
(setq folderout (LM:browseforfolder "Select a folder" nil 0))
(setq fileoutname (getstring "\nName of output files base >"))
(setq filecounter 0)
(princ)
)

(if (not folderout) (inittextout))

(setq filecounter (1+ filecounter))
(setq f (strcat folderout "/" fileoutname (itoa filecounter) ".txt"))
(setq file (open f "w"))
(setq ss (cadr (ssgetfirst)) i 0)
(while (< i (sslength ss))
(setq e (ssname ss i) ent (entget e))
(setq ty (strcase(cdr (assoc 0 ent)) T))
(if (= ty "text")
    (setq text (cdr (assoc 1 ent)))
)

(if (= ty "mtext")
    (progn
        (if (not (and(assoc 3 ent))) 
            (progn
                (setq text (cdr (assoc 1 ent)))
                (while (wcmatch text "*\\P*") (setq text (vl-string-subst "\n" "\\P" text)))
            )
            (progn
                (setq endtext (cdr (assoc 1 ent)))
                (cond (ent
                         (while (setq m (assoc 3 ent) ent (cdr (member m ent)))
                           (setq txts (cons (cdr m) txts))
                         )
                        )
                )
                (setq text "" txts (reverse txts))
                (foreach tx txts
                    (setq text (strcat text tx))
                )
            (setq text (strcat text endtext) endtext nil)
            (while (wcmatch text "*\\P*") (setq text (vl-string-subst "\n" "\\P" text)))
            )      
        )
    )
 
)

(setq listout (cons text listout))
(setq i (1+ i))
)
(setq text nil)
(foreach e listout
    (write-line e file)
)
(close file)
(princ (strcat "\nData is writen to " f))
(startapp "notepad" f)
(princ)
)

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 5 of 12

ferhatttcoskun
Enthusiast
Enthusiast
Accepted solution
Private Function PickText() As String

    Dim ent As AcadEntity
    Dim pt As Variant
    Dim txtEnt As AcadText
    Dim mtxtEnt As AcadMText
    Dim go As Boolean
    
    Dim val As String
    
    On Error Resume Next
    
    Do
        go = False
        ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Select a TEX/MText object:"
        
        If Err.Number <> 0 Then
            '' user pressed Esc, or clicked an empty location
            PickText = ""
            Exit Function
        End If
        
        If TypeOf ent Is AcadText Then
            Set txtEnt = ent
            val = txtEnt.TextString
        ElseIf TypeOf ent Is AcadMText Then
            Set mtxtEnt = ent
            val = mtxtEnt.TextString
        Else
            go = True
            ThisDrawing.Utility.Prompt vbCrLf & _
                "invalid selection: must be Text/MText object!" & vbCrLf
        End If
    
    Loop While go
    
    PickText = val
    
End Function
0 Likes
Message 6 of 12

hak_vz
Advisor
Advisor

Does this really solve your problem?

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 7 of 12

doaiena
Collaborator
Collaborator

@ferhatttcoskun You ask a question in the AutoLisp forum, you get your solution from @hak_vz . Yet you ignore him and post a piece of code, written in a different language, that does nothing more, than set a variable and mark it as a solution...

 

It is at best misleading to someone, who might be searching for the same solution.

0 Likes
Message 8 of 12

hak_vz
Advisor
Advisor

@ferhatttcoskun  asked the same question on visual basic forum and was given this solution by @norman.yuan 

https://forums.autodesk.com/t5/visual-basic-customization/select-text-from-the-screen-and-write-to-t... 

 

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 9 of 12

doaiena
Collaborator
Collaborator

Well, it looks like i have misinterpreted the objective.

0 Likes
Message 10 of 12

hak_vz
Advisor
Advisor

It is a question asked in a wrong forum. For someone who want to use it to extract text (mtext) into a textbox (application) it is a correct answer. If you want to use it instantly in everyday work, that's another story. 

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 11 of 12

ferhatttcoskun
Enthusiast
Enthusiast

I may have asked the question in the wrong place.
Thank you for your interest.

0 Likes
Message 12 of 12

hak_vz
Advisor
Advisor

In case you received a solution from someone else, make a link to that post in other forum and explain what you really asked, and why this is a solution.

It was a nice weekend making this, but I'll makethis code useful to myself.

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes