Replace text with block and transfer value into attribute

January 30, 2022

On 6/6/2018 at 9:55 AM, great_isme said:

....

Can you keep the attribute block angle same as the text before conversion? Before replacing, the text may be having different angle.

....

@great_isme

try this:

(defun c:MtxtToBlk1 (/ sel int ent att spc ang)
 ;; Tharwat - Date: 19.Jun.2017	;;
 (if
   (and
     (or (tblsearch "BLOCK" "ROOMTAG")
         (alert "Attributed Block <ROOMTAG> is not found in drawing <!>")
     )
     (princ "\nSelect Mtexts to be replaced with Attributed Block <ROOMTAG> :")
     (setq sel (ssget "_:L" '((0 . "MTEXT"))))

   )
    (progn
      (defun unformatmtext (string / text str)
        ;;	ASMI - sub-function			;;
        ;; Get string from Formatted Mtext string	;;
        (setq text "")
        (while (/= string "")
          (cond ((wcmatch (strcase (setq str (substr string 1 2)))
                          "\\[\\{}`~]"
                 )
                 (setq string (substr string 3)
                       text   (strcat text str)
                 )
                )
                ((wcmatch (substr string 1 1) "[{}]")
                 (setq string (substr string 2))
                )
                ((and (wcmatch (strcase (substr string 1 2)) "\\P")
                      (/= (substr string 3 1) " ")
                 )
                 (setq string (substr string 3)
                       text   (strcat text " ")
                 )
                )
                ((wcmatch (strcase (substr string 1 2)) "\\[LOP]")
                 (setq string (substr string 3))
                )
                ((wcmatch (strcase (substr string 1 2)) "\\[ACFHQTW]")
                 (setq string (substr string
                                      (+ 2 (vl-string-search ";" string))
                              )
                 )
                )
                ((wcmatch (strcase (substr string 1 2)) "\\S")
                 (setq str    (substr string 3 (- (vl-string-search ";" string) 2))
                       text   (strcat text (vl-string-translate "#^\\" " " str))
                       string (substr string (+ 4 (strlen str)))
                 )
                 (print str)
                )
                (t
                 (setq text   (strcat text (substr string 1 1))
                       string (substr string 2)
                 )
                )
          )
        )
        text
      )
      (setq spc
             (vlax-get (vla-get-activelayout
                         (vla-get-activedocument (vlax-get-acad-object))
                       )
                       'block
             )
      )
      (repeat (setq int (sslength sel))
        (setq ent (ssname sel (setq int (1- int))))
        (setq ang (cdr (assoc 50 (entget ent)))) ;; get the Mtext Angle (in radians) and set it to the variable ang
        (and (setq att (vla-insertblock
                         spc
                         (vlax-3d-point (cdr (assoc 10 (entget ent))))
                         "ROOMTAG"
                         1.0
                         1.0
                         1.0
                         ang ;; the block rotation from the Mtext rotation
                       )
             )
             (vl-some
               '(lambda (x)
                  (if (eq (strcase (vla-get-tagstring x)) "ROOMNO")
                    (progn (vla-put-textstring
                             x
                             (unformatmtext (cdr (assoc 1 (entget ent))))
                           )
                           t
                    )
                  )
                )
               (vlax-invoke att 'getattributes)
             )
             (progn (vla-put-layer att (cdr (assoc 8 (entget ent)))) t)
             (entdel ent)
        )
      )
    )
 )
 (princ)
)(vl-load-com)

Edited January 30, 2022 by aridzv

May 14

Thankyou for this.

Would there be an easy way to give the option of choosing between two source blocks to convert to.
For example when selecting the text to convert to block I can choose either " Block A" or " Block B"?

May 14

4 hours ago, KraZeyMike said:

Thankyou for this.

Would there be an easy way to give the option of choosing between two source blocks to convert to.
For example when selecting the text to convert to block I can choose either " Block A" or " Block B"?

Try this untested mods and get sure that you modify the tag name to suit yours as commented in codes below.

(defun c:Test (/ sel int ent att spc bkn )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (or *bkn* (setq *bkn* "A"))
  (if (and (or (initget 6 "A B")
               (setq *bkn* (cond ((getkword (strcat "\nSpecify block name A / B < " *bkn* " > : "))) (*bkn*)))
               )
           (or (tblsearch "BLOCK" (setq bkn (strcat (strcat "Block " *bkn*))))
               (alert (strcat "Attributed Block < " bkn " > was not found in drawing <!>"))
               )
           (princ "\nSelect Mtexts to be replaced with Attributed Block <ROOMTAG> :")
           (setq sel (ssget "_:L" '((0 . "MTEXT"))))
           )
    (progn
      (defun unformatmtext (string / text str)
        ;;	ASMI - sub-function			;;
        ;; Get string from Formatted Mtext string	;;
        (setq text "")
        (while (/= string "")
          (cond ((wcmatch (strcase (setq str (substr string 1 2)))
                          "\\[\\{}`~]"
                 )
                 (setq string (substr string 3)
                       text   (strcat text str)
                 )
                )
                ((wcmatch (substr string 1 1) "[{}]")
                 (setq string (substr string 2))
                )
                ((and (wcmatch (strcase (substr string 1 2)) "\\P")
                      (/= (substr string 3 1) " ")
                 )
                 (setq string (substr string 3)
                       text   (strcat text " ")
                 )
                )
                ((wcmatch (strcase (substr string 1 2)) "\\[LOP]")
                 (setq string (substr string 3))
                )
                ((wcmatch (strcase (substr string 1 2)) "\\[ACFHQTW]")
                 (setq string (substr string
                                      (+ 2 (vl-string-search ";" string))
                              )
                 )
                )
                ((wcmatch (strcase (substr string 1 2)) "\\S")
                 (setq str    (substr string 3 (- (vl-string-search ";" string) 2))
                       text   (strcat text (vl-string-translate "#^\\" " " str))
                       string (substr string (+ 4 (strlen str)))
                 )
                 (print str)
                )
                (t
                 (setq text   (strcat text (substr string 1 1))
                       string (substr string 2)
                 )
                )
          )
        )
        text
      )
      (setq spc
             (vlax-get (vla-get-activelayout
                         (vla-get-activedocument (vlax-get-acad-object))
                       )
                       'block
             )
      )
      (repeat (setq int (sslength sel))
        (setq ent (ssname sel (setq int (1- int))))
        (and (setq att (vla-insertblock
                         spc
                         (vlax-3d-point (cdr (assoc 10 (entget ent))))
                         bkn
                         1.0
                         1.0
                         1.0
                         0.
                       )
             )
             (vl-some
               '(lambda (x)
                  (if (eq (strcase (vla-get-tagstring x)) "ROOMNO") ;; change the tag name "ROOMNO" to suit yours
                    (progn (vla-put-textstring
                             x
                             (unformatmtext (cdr (assoc 1 (entget ent))))
                           )
                           t
                    )
                  )
                )
               (vlax-invoke att 'getattributes)
             )
             (entdel ent)
        )
      )
    )
 )
 (princ)
)(vl-load-com)

May 14

Thankyou Tharwat.
That's really close except I would like to use a drop down to select the actual block names rather than typing it in manually.
Or am I not editing this formula correctly?

For example I would like to structure it like this with four options for the four source blocks to convert to:

(cond ((getkword (strcat "\nSpecify block name [HPO Standard Text/HPO Small Text/DP Standard Text/DP Small Text] <HPO Standard Text>: ")) ("HPO Standard Text")))

Thanks again for your help with this. Still learning as I go and this forum is truly a great resource thanks to contributors like yourself.

Edited May 15 by KraZeyMike

May 15

Yeah its very possible but sorry I am busy at the meantime and maybe someone else could help you to modify the codes.

May 16

Please try the following untested program and you need to revise the tag string to suit yours as I mentioned earlier.

NOTE: you can enable the system variable DYNMODE and set it to 1 if you would like to have a drop down menu to pick a certain block name from the list.

(defun c:Test (/ sel int ent att spc bkn)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (or *bkn* (setq *bkn* "HPO-Standard-Text"))
  (and (or (initget 6 "HPO-Standard-Text HPO-Small-Text DP-Standard-Text DP-Small-Text")
           (setq *bkn*
                  (cond ((getkword
                           (strcat
                             "\nSpecify block name [HPO-Standard-Text , HPO-Small-Text , DP-Standard-Text , DP-Small-Text] < "
                             *bkn*
                             " > : "
                             )
                           )
                         )
                        (*bkn*)
                        )
                 )
           )
       (or (tblsearch "BLOCK" (setq bkn (vl-string-translate "-" " " *bkn*)))
        (alert (strcat "Attributed Block < "
                       bkn
                       " > was not found in drawing <!>"
                       )
               )
           )
       (princ "\nSelect Mtexts to be replaced with Attributed Block :")
       (setq sel (ssget "_:L" '((0 . "MTEXT"))))
       (setq spc (vlax-get (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))
                           'block
                           )
             )
       (repeat (setq int (sslength sel))
         (setq ent (ssname sel (setq int (1- int))))
         (and (setq att (vla-insertblock
                          spc
                          (vlax-3d-point (cdr (assoc 10 (entget ent))))
                          bkn
                          1.0
                          1.0
                          1.0
                          0.
                          )
                    )
              (vl-some
                '(lambda (x)
                   (if (eq (strcase (vla-get-tagstring x)) "ROOMNO")
                     ;; change the tag name "ROOMNO" to suit yours
                     (progn (vla-put-textstring
                              x
                              (unformatmtext (cdr (assoc 1 (entget ent))))
                              )
                       t
                       )
                     )
                   )
                (vlax-invoke att 'getattributes)
                )
              (entdel ent)
              )
         )
       )
  (princ)
  ) (vl-load-com)
;;				;;
(defun unformatmtext (string / text str)
  ;;	ASMI - sub-function			;;
  ;; Get string from Formatted Mtext string	;;
  (setq text "")
  (while (/= string "")
    (cond ((wcmatch (strcase (setq str (substr string 1 2)))
                    "\\[\\{}`~]"
           )
           (setq string (substr string 3)
                 text   (strcat text str)
           )
          )
          ((wcmatch (substr string 1 1) "[{}]")
           (setq string (substr string 2))
          )
          ((and (wcmatch (strcase (substr string 1 2)) "\\P")
                (/= (substr string 3 1) " ")
           )
           (setq string (substr string 3)
                 text   (strcat text " ")
           )
          )
          ((wcmatch (strcase (substr string 1 2)) "\\[LOP]")
           (setq string (substr string 3))
          )
          ((wcmatch (strcase (substr string 1 2)) "\\[ACFHQTW]")
           (setq string (substr string
                                (+ 2 (vl-string-search ";" string))
                        )
           )
          )
          ((wcmatch (strcase (substr string 1 2)) "\\S")
           (setq str    (substr string 3 (- (vl-string-search ";" string) 2))
                 text   (strcat text (vl-string-translate "#^\\" " " str))
                 string (substr string (+ 4 (strlen str)))
           )
           (print str)
          )
          (t
           (setq text   (strcat text (substr string 1 1))
                 string (substr string 2)
           )
          )
    )
  )
  text
)
;;				;;

May 16

Just tried it then when I got to work.

Worked great except that the Layer and Alignment of the source text is not kept as before.

ie. Defaults to 90d and layer 0

Can we please incorporate these functions back into the new Lisp?

Thanks again for your help

For Reference this is the code I was using that was working exactly as intended, but without the option for multiple blocks as above, I've been playing with it for a little while now and can't seem to get the highlighted section to incorporate properly into the code above.

Quote

(defun c:TTB (/ sel int ent att spc ang)
;; Find and Replace for Block and Tag Name   ;;
;; Add "M" to TEXT on line 10 for mText selection ;;
(if
(and
(or (tblsearch "BLOCK" "DP Boundary")
(alert "Attributed Block <DP Boundary> is not found in drawing <!>")
)
(princ "\nSelect texts to be replaced with Attributed Block <DP Boundary> :")
(setq sel (ssget "_:L" '((0 . "TEXT"))))

)
(progn
(defun unformatmtext (string / text str)
;;   ASMI - sub-function           ;;
;; Get string from Formatted text string   ;;
(setq text "")
(while (/= string "")
(cond ((wcmatch (strcase (setq str (substr string 1 2)))
"\\[\\{}`~]"
)
(setq string (substr string 3)
text (strcat text str)
)
)
((wcmatch (substr string 1 1) "[{}]")
(setq string (substr string 2))
)
((and (wcmatch (strcase (substr string 1 2)) "\\P")
(/= (substr string 3 1) " ")
)
(setq string (substr string 3)
text (strcat text " ")
)
)
((wcmatch (strcase (substr string 1 2)) "\\[LOP]")
(setq string (substr string 3))
)
((wcmatch (strcase (substr string 1 2)) "\\[ACFHQTW]")
(setq string (substr string
(+ 2 (vl-string-search ";" string))
)
)
)
((wcmatch (strcase (substr string 1 2)) "\\S")
(setq str (substr string 3 (- (vl-string-search ";" string) 2))
text (strcat text (vl-string-translate "#^\\" " " str))
string (substr string (+ 4 (strlen str)))
)
(print str)
)
(t
(setq text (strcat text (substr string 1 1))
string (substr string 2)
)
)
)
)
text
)
(setq spc
(vlax-get (vla-get-activelayout
(vla-get-activedocument (vlax-get-acad-object))
)
'block
)
)
(repeat (setq int (sslength sel))
(setq ent (ssname sel (setq int (1- int))))
(setq ang (cdr (assoc 50 (entget ent)))) ;; get the text Angle (in radians) and set it to the variable ang
(and (setq att (vla-insertblock
spc
(vlax-3d-point (cdr (assoc 10 (entget ent))))
"DP Boundary"
1.0
1.0
1.0
ang ;; the block rotation from the text rotation
)
)
(vl-some
'(lambda (x)
(if (eq (strcase (vla-get-tagstring x)) "Z")
(progn (vla-put-textstring
x
(unformatmtext (cdr (assoc 1 (entget ent))))
)
t
)
)
)
(vlax-invoke att 'getattributes)
)
(progn (vla-put-layer att (cdr (assoc 8 (entget ent)))) t)
(entdel ent)
)
)
)
)
(princ)
)(vl-load-com)

Edited May 17 by KraZeyMike

May 17

Update:

After a bit of shuffling between the two codes I got it to work. Thanks again

Working now with both Text and Mtext using (setq sel (ssget "_:L" '((0 . "TEXT,MTEXT"))))

Edited May 17 by KraZeyMike

May 17

Just one small thing, the insertion point seems to be defaulting to the left of the standard text as if its left justified rather than the insertion point being centre node of text. Mtext works fine though. Is there an easy way to correct it in the edited code attached?

Attached is the current working Lisp thanks to your help already
To centre the Standard Text properly when running the command would be perfect.

TTB (Text to Block).lsp

Edited May 20 by KraZeyMike

May 17

Why did you remove my name from my codes ? And you call them YOUR codes?

Do you expect any help with that disrespectful manner?

May 17

My apologies, spent this morning copying and moving parts around to get it to work and I didn't add my name into the codes anywhere.

I am still learning and never meant any disrespect.

I do really appreciate the help

Edited May 17 by KraZeyMike

May 20

After re-reading the post above I can see the confusion. It was hurriedly typed on Friday before the weekend. (since edited)
I am honestly not trying to take credit for anybody else's work. I simply wanted to differentiate between your original lisp posted and the edited one I uploaded for both text and mtext together with layer and alignment.

Edited May 20 by KraZeyMike

May 21

; Original Lisp by Barney Rubble May 1990

; Plus other lines here and there

; Modified by Fred Flinstone adding xyz to function May 2024

Sign In

Replace text with block and transfer value into attribute

Recommended Posts

aridzv

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Tharwat

BIGAL

Tharwat

KraZeyMike

Tharwat

KraZeyMike

Tharwat

Tharwat

KraZeyMike

KraZeyMike

KraZeyMike

Tharwat

KraZeyMike

KraZeyMike

BIGAL

Join the conversation

Tharwat

BIGAL

Tharwat

Tutorials

Forums

Activity