Topic: Hard Purge Inquiry: UnPurgeable Text Style

[chilldaddy]

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 style or other data not visible and proving impossible to purge. 

Please provide:
Links to and/or actual LISP programs that perform this PURGE.
LISP tips and/or instruction on links to methods to create a HARD PURGE (object style in use) LISP program.

[ribarm]

To purge specific style, you'll have to change all objects residing that specific style to newly created one, or like in code to "Standard" text style... Then use PURGE command - style option - all styles...

Code - Auto/Visual Lisp: [Select]

1. (defun c:change_all_txt_to_standard ( / ss i e ex )
2.   (prompt "\nSelect text entities...")
3.   (if (setq ss (ssget "_:L" (list (cons 0 "*TEXT"))))
4.     (repeat (setq i (sslength ss))
5.       (setq e (ssname ss (setq i (1- i))))
6.       (setq ex (entget e))
7.       (entupd (cdr (assoc -1 (entmod (subst (cons 7 "Standard") (assoc 7 ex) ex)))))
8.     )
9.   )
10.   (if command-s
11.     (command-s "_.-purge" "_st" "*" "_n")
12.     (vl-cmdf "_.-purge" "_st" "*" "_n")
13.   )
14.   (princ)
15. )
16.  

The code is untested, but I hope you understand something so you can change it to your needs...

M.R.

[kozmos]

Purge TextStyle is quite complicated as other than text, attributes, dimstyles, leaderstyles, tablestyles and some mtexts with control characters will use it too. Unless all of the used parties are taken care of, the textstyle may remain unpurgable.

[BIGAL]

Dont forget Civ3D styles they will lock a text style as non purgeable.

[ronjonp]

There is this recent post too: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-auto-visual-lisp-to-combine-text-styles/m-p/12654620#M463597

[ribarm]

With Ron's comment and his example I cobbled something that should work, but it needs testings from OP...

Code - Auto/Visual Lisp: [Select]

1. (defun c:change_all_to_standard_purge_styles ( / lay laylst ss i e ex )
2.   (while (setq lay (tblnext "LAYER" (not lay)))
3.     (if (= 4 (logand 4 (cdr (assoc 70 lay))))
4.       (setq laylst (cons (cdr (assoc 2 lay)) laylst))
5.     )
6.   )
7.   (foreach lay laylst
8.     (if command-s
9.       (command-s "_.-layer" "_u" lay "")
10.       (vl-cmdf "_.-layer" "_u" lay "")
11.     )
12.   )
13.   (if (setq ss (ssget "_X"))
14.     (repeat (setq i (sslength ss))
15.       (setq e (ssname ss (setq i (1- i))))
16.       (setq ex (entget e))
17.       (if (assoc 7 ex)
18.         (entupd (cdr (assoc -1 (entmod (subst (cons 7 "Standard") (assoc 7 ex) ex)))))
19.       )
20.     )
21.   )
22.   (if command-s
23.     (command-s "_.-purge" "_st" "*" "_n")
24.     (vl-cmdf "_.-purge" "_st" "*" "_n")
25.   )
26.   (foreach lay laylst
27.     (if command-s
28.       (command-s "_.-layer" "_lo" lay "")
29.       (vl-cmdf "_.-layer" "_lo" lay "")
30.     )
31.   )
32.   (princ)
33. )
34.  

M.R.

[danAllen]

I use code from this: https://www.theswamp.org/index.php?topic=14247.msg172118#msg172118

[ribarm]

OK, Dan...

Code - Auto/Visual Lisp: [Select]

1. (defun c:PurgeAllTextObjectsStyles ( / vl-load ChangeAllTextObjectsStyle laylst lay )
2.  
3.   (defun vl-load nil
4.     (or cad
5.       (cond
6.         ( (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil)))
7.           (setq cad (vlax-get-acad-object))
8.         )
9.         ( t
10.           (vl-load-com)
11.           (setq cad (vlax-get-acad-object))
12.         )
13.       )
14.     )
15.     (or doc (setq doc (vla-get-activedocument cad)))
16.     (or alo (setq alo (vla-get-activelayout doc)))
17.     (or spc (setq spc (vla-get-block alo)))
18.   )
19.  
20.   (defun ChangeAllTextObjectsStyle ( Doc StyName / tempObjType ColCnt RowCnt )
21.     (vlax-for Blk (vla-get-Blocks Doc)
22.       (if (= (vla-get-IsXref Blk) :vlax-false)
23.         (vlax-for Obj Blk
24.           (setq tempObjType (vla-get-ObjectName Obj))
25.           (cond
26.             ( (vl-position tempObjType '("AcDbText" "AcDbMText" "AcDbAttributeDefinition"))
27.               (vla-put-StyleName Obj StyName)
28.             )
29.             ( (wcmatch tempObjType "AcDb*Dimension")
30.               (vla-put-TextStyle Obj StyName)
31.             )
32.             ( (= tempObjType "AcDbBlockReference")
33.               (foreach Att (vlax-invoke Obj 'GetAttributes)
34.                 (vla-put-StyleName Att StyName)
35.               )
36.               (foreach Att (vlax-invoke Obj 'GetConstantAttributes)
37.                 (vla-put-StyleName Att StyName)
38.               )
39.             )
40.             ( (= tempObjType "AcDbTable")
41.               (setq ColCnt 0)
42.               (repeat (vla-get-Columns Obj)
43.                 (setq RowCnt 0)
44.                 (repeat (vla-get-Rows Obj)
45.                   (vlax-invoke Obj 'SetCellTextStyle RowCnt ColCnt StyName)
46.                   (setq RowCnt (1+ RowCnt))
47.                 )
48.                 (setq ColCnt (1+ ColCnt))
49.               )
50.             )
51.           )
52.         )
53.       )
54.     )
55.   )
56.  
57.   (or (and cad doc alo spc) (vl-load))
58.   (while (setq lay (tblnext "LAYER" (not lay)))
59.     (if (= 4 (logand 4 (cdr (assoc 70 lay))))
60.       (setq laylst (cons (cdr (assoc 2 lay)) laylst))
61.     )
62.   )
63.   (foreach lay laylst
64.     (if command-s
65.       (command-s "_.-layer" "_u" lay "")
66.       (vl-cmdf "_.-layer" "_u" lay "")
67.     )
68.   )
69.   (ChangeAllTextObjectsStyle doc "Standard")
70.   (if command-s
71.     (command-s "_.-purge" "_st" "*" "_n")
72.     (vl-cmdf "_.-purge" "_st" "*" "_n")
73.   )
74.   (foreach lay laylst
75.     (if command-s
76.       (command-s "_.-layer" "_lo" lay "")
77.       (vl-cmdf "_.-layer" "_lo" lay "")
78.     )
79.   )
80.   (princ)
81. )
82.  

M.R.