Undesired Text Style Removal of Non-Purgeable

[Clint]

Goal:

Find methods to help assemble a new LISP program or find an existing LISP program to perform the following:

Purge an undesired  text style that is referenced by an object property or other data not visible and proving impossible to purge.

 

Please provide:

Links to and/or actual LISP programs that perform this or similar object PURGES.

LISP tips and/or instruction on links to methods to create a HARD PURGE (object style in use) LISP program.

 

Thanks for reviewing this inquiry!

 

Clint

[pkenewell]

Have you attempted to do any code? Here are some hints:

;; Create a selection set of the Text Objects and Text Style:
(setq ss (ssget "X" '((0 . "*TEXT")(7 . "OldStyleName"))))

;; If the Style table does not have the new Style Name, Make it.
(if (not (tblsearch "STYLE" "NewStyleName"))
   (command "._-style" "NewStyleName" "arial.ttf" 0.0 1.0 0.0 "_n" "_n")
)

;; If the selecction set is found:
(if ss
   ;; Iterate through the selection set - set counter to the length of the set:
   (repeat (setq cnt (sslength ss))
      ;; Get the entity list of item in selection set.
      (setq el (entget (ssname ss (setq cnt (1- cnt))))
                ;; Substitute the new Text Style name in place of the old one.
            el (subst (cons 7 "NewStyleName") (assoc 7 el) el)
      )
      ;; Modify the entity.
      (entmod el)
   )
)

;; Purge the old Style.
(command "._-purge" "_ST" "OldStyleName" "_N")

 

Edited March 19 by pkenewell

[Clint]

Hi pkenewell! I have not. A great snippet for future study is this one. Thank you!

 

[pkenewell]

18 minutes ago, Clint said:

Hi pkenewell! I have not. A great snippet for future study is this one. Thank you!

 

@Clint NOTE: Oops - I had to update the code because I messed up the counter in the (repeat... part. Previous post is updated.

 

Another Hint - if you wrap this code in between (defun c:MyCommand () ... ), it will do what you need. you'll have to change "OldStyleName" and "NewStyleName" to your needs.

Edited March 19 by pkenewell

[pkenewell]

@Clint So - did you try doing the code? Were you successful? do you have any questions? We like to think that we are actually educating new coders, since that is the purpose of this forum. It's not here to request free programs, although that's what happens more often than not.

[Clint]

Hello again "pkenewell", Thank you!

 

With other tasks just completed, I am just now focusing on this issue again. I will be glad to update you.

 

I support the main goals of this forum and, now at a DWG-based only environment, my interest in LISP mastery is renewed with a desire to be a code producer - in your shoes.

 

In this instance, the immediacy for a resolution calls for the embarrassingly desperate search  for code.

My plan is not to be in the role of beggar for long. 

 

Thanks,

Clint

[Steven P]

Might also look at purging anonymous blocks - not sure if it will be a solution but if all else fails.. ( I think there was either a post on here somewhere or Lee Mac has something on his website)

[pkenewell]

@Clint OK - well since I have already done most of the work for you, I might was well give you a full solution. See the attached. I improved the code to have an UNDO group, and run quietly, eliminating the command echoing and displaying just the results. You will still need to alter the code for your desired old and new text styles. If the new text style is already in the drawing, it will just use what is defined rather than create it.

;|==============================================================
CHTS.lsp written by Phil Kenewell - 3/19/2024

Description: This program converts all Text objects (TEXT, MTEXT, RTEXT) from
             one Text style to another, then purges the old text style. The
             desired styles need to be preset in the variables noted in the
             comments of the code.

Last Update: Initial Release 3/20/2024

===============================================================|;

(defun C:CHTS (/ ce cnt d el NewFontFile NewTextHght NewTextoblq NewTextStyle NewTextWdth OldTextStyle ss ts)
   
   ;; Presets for Old and New Text style names.
   (setq OldTextStyle "MyoldStyle" ;; Old Style to Purge
         NewTextStyle "MyNewStyle" ;; New style to move text objects to
         NewFontFile  "arial.ttf"  ;; Font file for new Text.
         NewTextHght  0.0          ;; Preset hieght (if needed) for new text style
         NewTextWdth  1.0          ;; Width Factor (if needed) for new text style
         NewTextoblq  0.0          ;; Oblique angle (if needed) for new text style
   )

   ;; Create an undo mark.
   (vla-startundomark (setq d (vla-get-activedocument (vlax-get-acad-object))))
   ;; Save the values for cmdecho and textstyle.
   (setq ce (getvar "cmdecho") ts (getvar "textstyle"))
   ;; turn off cmdecho to clean up command line echoing.
   (setvar "cmdecho" 0)
   ;; Create a selection set of the Text Objects and Text Style:
   (setq ss (ssget "X" (list (cons 0 "*TEXT")(cons 7 OldTextStyle))))

   ;; If the Style table does not have the new Style Name, Make it.
   (if (not (tblsearch "STYLE" NewTextStyle))
      (command "._-style" NewTextStyle NewFontFile NewTextHght NewTextWdth NewTextoblq "_n" "_n")
   )

   ;; If the selection set is found:
   (if ss
      ;; Iterate through the selection set - set counter to the length of the set:
      (repeat (setq cnt (sslength ss))
         ;; Get the entity list of item in selection set.
         (setq el (entget (ssname ss (setq cnt (1- cnt))))
                   ;; Substitute the new Text Style name in place of the old one.
               el (subst (cons 7 NewTextStyle) (assoc 7 el) el)
         )
         ;; Modify the entity.
         (entmod el)
         (if (= cnt 0)(princ (strcat "\n(" (itoa (sslength ss)) ") Text objects were changed to style \"" NewTextStyle "\".")))
      )
      (princ (strcat "\nNo Text objects with style \"" OldTextStyle "\" were found."))
   )

   ;; Purge the old Style.
   (vla-delete (vlax-ename->vla-object (tblobjname "STYLE" OldTextStyle)))
   (if (not (tblsearch "STYLE" OldTextStyle))
      (princ (strcat "\nText Style \"" OldTextStyle "\" was successfully purged."))
   )
   ;; If the previously current text style was not the old style to be purged, then reset the text style to what it was.
   (if (/= ts OldTextStyle)(setvar "textstyle" ts))
   ;; Set cmdecho to previous value
   (setvar "cmdecho" ce)
   ;; End the undo mark
   (vla-endundomark d)
   ;; exit quietly
   (princ)
)

 

 

CHTS.lsp

Edited March 20 by pkenewell

[Clint]

I thank you for taking your valuable time here getting us out of a "sticky" spot. Now, to learn from this program and others and give back one day soon!

 

Yours,

 

Clint

[Steven P]

Just can't help yourself. Get half way there, give the good advice, off you go OP all yours to finish off, brilliant learning opportunity, but... while thinking about it I'll just do it to satisfy myself... we all do it

[Clint]

To pkenewell:

 

Your CHTS.lsp worked like magic. With nearly 1,000 detail drawings with various issues, including the text style conundrum, now automated away, processing them will now take at most 5% of the former rate.

 

You inspired me to take time to learn LISP!

 

Clint

[pkenewell]

8 minutes ago, Clint said:

You inspired me to take time to learn LISP!

@Clint Thank you! I hope to see you developing routines and asking questions from the forum.