Replace text with block and transfer value into attribute

[aridzv]

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

[KraZeyMike]

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"?

[Tharwat]

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)

 

[KraZeyMike]

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 Wednesday at 06:44 AM by KraZeyMike

[Tharwat]

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

[Tharwat]

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
)
;;				;;

 

[KraZeyMike]

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 Friday at 01:21 AM by KraZeyMike

[KraZeyMike]

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 Friday at 02:39 AM by KraZeyMike

[KraZeyMike]

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 my code attached?

Attached is my 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 Friday at 04:57 AM by KraZeyMike

[Tharwat]

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

Do you expect any help with that disrespectful manner?

[KraZeyMike]

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 Friday at 07:18 AM by KraZeyMike