Author Topic: FIND AND REPLACE TEXT WITH BLOCK Credit Tharwat  (Read 280 times)

0 Members and 1 Guest are viewing this topic.

Lonnie

  • Newt
  • Posts: 143
FIND AND REPLACE TEXT WITH BLOCK Credit Tharwat
« on: January 25, 2023, 03:32:06 PM »
I found this lisp routine that works almost perfect now. Problem is it I can get it to work only in paperspace and I need it to work in modelspace.

Code: [Select]
(defun c:Test (/ sel int ent att spc)
 ;; Tharwat - Date: 19.Jun.2017 ;;
 (if
   (and
     (or (tblsearch "BLOCK" "fixturebubble")
         (alert "Attributed Block <fixturebubble> is not found in drawing <!>")
     )
     (princ "\nSelect Mtexts to be replaced with Attributed Block <fixturebubble> :")
     (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))))
                         "fixturebubble"
                         96
                         96
                         96
                         0.
                       )
             )
             (vl-some
               '(lambda (x)
                  (if (eq (strcase (vla-get-tagstring x)) "S")
                    (progn (vla-put-textstring
                             x
                             (unformatmtext (cdr (assoc 1 (entget ent))))
                           )
                           t
                    )
                  )
                )
               (vlax-invoke att 'getattributes)
             )
             (entdel ent)
        )
      )
    )
 )
 (princ)
)(vl-load-com)


After that's done I need to add two other things to the lisp.

1. When choosing the text I want to keep it's rotation instead of the 0 rotation it's defaulted to.
2. I need choose few other objects to just erase before I go to the next piece of text.

Lonnie

  • Newt
  • Posts: 143
Re: FIND AND REPLACE TEXT WITH BLOCK Credit Tharwat
« Reply #1 on: January 26, 2023, 02:55:06 PM »
Fixed and working

kdub

  • Mesozoic keyThumper
  • SuperMod
  • Water Moccasin
  • Posts: 1602
  • class keyThumper<T>:ILazy<T>
Re: FIND AND REPLACE TEXT WITH BLOCK Credit Tharwat
« Reply #2 on: January 26, 2023, 03:16:29 PM »
@Lonnie,

I'm sure someone ( in the future ) would appreciate your postong the modified code with any explanatory notes you want to add.

Regards,
Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

some people complain about loading the dishwasher

Sometimes the question is more important than the answer.

JohnK

  • Administrator
  • Seagull
  • Posts: 10207
Re: FIND AND REPLACE TEXT WITH BLOCK Credit Tharwat
« Reply #3 on: January 26, 2023, 03:21:58 PM »
You can also give this a try to see if it helps (I modified a previously written "TXTFIND" routine).
https://www.theswamp.org/index.php?topic=4591.msg605179#msg605179
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

Lonnie

  • Newt
  • Posts: 143
Re: FIND AND REPLACE TEXT WITH BLOCK Credit Tharwat
« Reply #4 on: January 26, 2023, 04:57:58 PM »
Sorry. I did not have the time to devote to an answer and if I wait some helpful person could have burned up their time so I answered really fast.

« Last Edit: January 27, 2023, 04:07:13 PM by Lonnie »

Lonnie

  • Newt
  • Posts: 143
Re: FIND AND REPLACE TEXT WITH BLOCK Credit Tharwat
« Reply #5 on: January 27, 2023, 04:34:16 PM »
Most of my problem was in the block I created and not in the lisp. When scaling the handle point of the block was not right. When it was scaled 96 x it simply was so far off the screen I could not find it. 


Here is what I have so far. I am also attaching the block it anyone wants it.
As a caution the rotation does not work well. 0 is fine but any other adds extra rotation.

Code: [Select]
(defun c:Bc1 (/ sel int ent att spc Size1 an1)
 ;; Tharwat - Date: 19.Jun.2017 ;;
 (setq Size1 (getvar "dimscale"))
 (setq an1 (getint  "What rotation :"))
 
 (if
   (and
     (or (tblsearch "BLOCK" "fixturebubble")
         (alert "Attributed Block <fixturebubble> is not found in drawing <!>")
     )
     (princ "\nSelect Mtexts to be replaced with Attributed Block <fixturebubble> :")
     (setq sel (ssget "_:L" '((0 . "text,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))))
                         "fixturebubble"
                         Size1
                         Size1
                         Size1
                         an1
                       )
             )
             (vl-some
               '(lambda (x)
                  (if (eq (strcase (vla-get-tagstring x)) "SYS")
                    (progn (vla-put-textstring
                             x
                             (unformatmtext (cdr (assoc 1 (entget ent))))
                           )
                           t
                    )
                  )
                )
               (vlax-invoke att 'getattributes)
             )
             (entdel ent)
        )
      )
    )
 )
 (princ)
)(vl-load-com)


Lonnie

  • Newt
  • Posts: 143
Re: FIND AND REPLACE TEXT WITH BLOCK Credit Tharwat
« Reply #6 on: February 02, 2023, 12:48:15 PM »
Rummaging around I found a newer version of this lisp done by Tharwat https://www.cadtutor.net/forum/topic/63404-replace-text-with-block-and-transfer-value-into-attribute/page/2/

The only change I had to make was to make the symbol scale=to dimscale as I did above. Worked perfectly.