Welcome,
Guest
. Please
login
or
register
.
1 Hour
1 Day
1 Week
1 Month
Forever
Login with username, password and session length
News:
Home
Help
Login
Register
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
Hard Purge Inquiry: UnPurgeable Text Style
« previous
next »
Print
Pages: [
1
] |
Go Down
Author
Topic: Hard Purge Inquiry: UnPurgeable Text Style (Read 472 times)
0 Members and 1 Guest are viewing this topic.
chilldaddy
Guest
Hard Purge Inquiry: UnPurgeable Text Style
«
on:
March 19, 2024, 02:09:23 PM »
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.
Logged
ribarm
Gator
Posts: 3307
Marko Ribar, architect
WWW
Re: Hard Purge Inquiry: UnPurgeable Text Style
«
Reply #1 on:
March 19, 2024, 03:23:55 PM »
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]
(
defun
c:change_all_txt_to_standard
(
/
ss i e ex
)
(
prompt
"
\n
Select text entities..."
)
(
if
(
setq
ss
(
ssget
"_:L"
(
list
(
cons
0
"*TEXT"
)
)
)
)
(
repeat
(
setq
i
(
sslength
ss
)
)
(
setq
e
(
ssname
ss
(
setq
i
(
1-
i
)
)
)
)
(
setq
ex
(
entget
e
)
)
(
entupd
(
cdr
(
assoc
-
1
(
entmod
(
subst
(
cons
7
"Standard"
)
(
assoc
7
ex
)
ex
)
)
)
)
)
)
)
(
if
command
-
s
(
command
-
s
"_.-purge"
"_st"
"*"
"_n"
)
(
vl-cmdf
"_.-purge"
"_st"
"*"
"_n"
)
)
(
princ
)
)
The code is untested, but I hope you understand something so you can change it to your needs...
M.R.
«
Last Edit: March 19, 2024, 03:30:45 PM by ribarm
»
Logged
Marko Ribar, d.i.a.
(graduated engineer of architecture)
M.R. on Youtube
kozmos
Newt
Posts: 115
Re: Hard Purge Inquiry: UnPurgeable Text Style
«
Reply #2 on:
March 20, 2024, 01:31:13 AM »
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.
«
Last Edit: March 20, 2024, 01:39:45 AM by kozmos
»
Logged
KozMos Inc.
BIGAL
Swamp Rat
Posts: 1433
40 + years of using Autocad
Re: Hard Purge Inquiry: UnPurgeable Text Style
«
Reply #3 on:
March 20, 2024, 07:50:22 PM »
Dont forget Civ3D styles they will lock a text style as non purgeable.
Logged
A man who never made a mistake never made anything
ronjonp
Needs a day job
Posts: 7531
Re: Hard Purge Inquiry: UnPurgeable Text Style
«
Reply #4 on:
March 21, 2024, 09:59:49 AM »
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
Logged
Windows 11 x64 - AutoCAD /C3D 2023
Custom Build PC
ribarm
Gator
Posts: 3307
Marko Ribar, architect
WWW
Re: Hard Purge Inquiry: UnPurgeable Text Style
«
Reply #5 on:
March 21, 2024, 12:42:28 PM »
With Ron's comment and his example I cobbled something that should work, but it needs testings from OP...
Code - Auto/Visual Lisp:
[Select]
(
defun
c:change_all_to_standard_purge_styles
(
/
lay laylst ss i e ex
)
(
while
(
setq
lay
(
tblnext
"LAYER"
(
not
lay
)
)
)
(
if
(
=
4
(
logand
4
(
cdr
(
assoc
70
lay
)
)
)
)
(
setq
laylst
(
cons
(
cdr
(
assoc
2
lay
)
)
laylst
)
)
)
)
(
foreach
lay laylst
(
if
command
-
s
(
command
-
s
"_.-layer"
"_u"
lay
""
)
(
vl-cmdf
"_.-layer"
"_u"
lay
""
)
)
)
(
if
(
setq
ss
(
ssget
"_X"
)
)
(
repeat
(
setq
i
(
sslength
ss
)
)
(
setq
e
(
ssname
ss
(
setq
i
(
1-
i
)
)
)
)
(
setq
ex
(
entget
e
)
)
(
if
(
assoc
7
ex
)
(
entupd
(
cdr
(
assoc
-
1
(
entmod
(
subst
(
cons
7
"Standard"
)
(
assoc
7
ex
)
ex
)
)
)
)
)
)
)
)
(
if
command
-
s
(
command
-
s
"_.-purge"
"_st"
"*"
"_n"
)
(
vl-cmdf
"_.-purge"
"_st"
"*"
"_n"
)
)
(
foreach
lay laylst
(
if
command
-
s
(
command
-
s
"_.-layer"
"_lo"
lay
""
)
(
vl-cmdf
"_.-layer"
"_lo"
lay
""
)
)
)
(
princ
)
)
M.R.
Logged
Marko Ribar, d.i.a.
(graduated engineer of architecture)
M.R. on Youtube
danAllen
Newt
Posts: 134
Re: Hard Purge Inquiry: UnPurgeable Text Style
«
Reply #6 on:
March 21, 2024, 02:10:28 PM »
I use code from this:
https://www.theswamp.org/index.php?topic=14247.msg172118#msg172118
Logged
ribarm
Gator
Posts: 3307
Marko Ribar, architect
WWW
Re: Hard Purge Inquiry: UnPurgeable Text Style
«
Reply #7 on:
March 21, 2024, 04:49:29 PM »
OK, Dan...
Code - Auto/Visual Lisp:
[Select]
(
defun
c:PurgeAllTextObjectsStyles
(
/
vl
-
load
ChangeAllTextObjectsStyle laylst lay
)
(
defun
vl
-
load
nil
(
or
cad
(
cond
(
(
not
(
vl-catch-all-error-p
(
vl
-
catch
-
all
-
apply
(
function
vlax-get-acad-object
)
nil
)
)
)
(
setq
cad
(
vlax-get-acad-object
)
)
)
(
t
(
vl-load-com
)
(
setq
cad
(
vlax-get-acad-object
)
)
)
)
)
(
or
doc
(
setq
doc
(
vla-get-activedocument
cad
)
)
)
(
or
alo
(
setq
alo
(
vla-get-activelayout
doc
)
)
)
(
or
spc
(
setq
spc
(
vla-get-block
alo
)
)
)
)
(
defun
ChangeAllTextObjectsStyle
(
Doc StyName
/
tempObjType ColCnt RowCnt
)
(
vlax-for
Blk
(
vla-get-Blocks
Doc
)
(
if
(
=
(
vla-get-IsXref
Blk
)
:vlax-false
)
(
vlax-for
Obj Blk
(
setq
tempObjType
(
vla-get-ObjectName
Obj
)
)
(
cond
(
(
vl-position
tempObjType '
(
"AcDbText"
"AcDbMText"
"AcDbAttributeDefinition"
)
)
(
vla-put-StyleName
Obj StyName
)
)
(
(
wcmatch
tempObjType
"AcDb*Dimension"
)
(
vla-put-TextStyle
Obj StyName
)
)
(
(
=
tempObjType
"AcDbBlockReference"
)
(
foreach
Att
(
vlax-invoke
Obj 'GetAttributes
)
(
vla-put-StyleName
Att StyName
)
)
(
foreach
Att
(
vlax-invoke
Obj 'GetConstantAttributes
)
(
vla-put-StyleName
Att StyName
)
)
)
(
(
=
tempObjType
"AcDbTable"
)
(
setq
ColCnt
0
)
(
repeat
(
vla-get-Columns
Obj
)
(
setq
RowCnt
0
)
(
repeat
(
vla-get-Rows
Obj
)
(
vlax-invoke
Obj 'SetCellTextStyle RowCnt ColCnt StyName
)
(
setq
RowCnt
(
1+
RowCnt
)
)
)
(
setq
ColCnt
(
1+
ColCnt
)
)
)
)
)
)
)
)
)
(
or
(
and
cad doc alo spc
)
(
vl
-
load
)
)
(
while
(
setq
lay
(
tblnext
"LAYER"
(
not
lay
)
)
)
(
if
(
=
4
(
logand
4
(
cdr
(
assoc
70
lay
)
)
)
)
(
setq
laylst
(
cons
(
cdr
(
assoc
2
lay
)
)
laylst
)
)
)
)
(
foreach
lay laylst
(
if
command
-
s
(
command
-
s
"_.-layer"
"_u"
lay
""
)
(
vl-cmdf
"_.-layer"
"_u"
lay
""
)
)
)
(
ChangeAllTextObjectsStyle doc
"Standard"
)
(
if
command
-
s
(
command
-
s
"_.-purge"
"_st"
"*"
"_n"
)
(
vl-cmdf
"_.-purge"
"_st"
"*"
"_n"
)
)
(
foreach
lay laylst
(
if
command
-
s
(
command
-
s
"_.-layer"
"_lo"
lay
""
)
(
vl-cmdf
"_.-layer"
"_lo"
lay
""
)
)
)
(
princ
)
)
M.R.
«
Last Edit: March 22, 2024, 02:56:44 AM by ribarm
»
Logged
Marko Ribar, d.i.a.
(graduated engineer of architecture)
M.R. on Youtube
Print
Pages: [
1
] |
Go Up
« previous
next »
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
Hard Purge Inquiry: UnPurgeable Text Style