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:
Replace Block Lisp
« previous
next »
Print
Pages: [
1
] |
Go Down
Author
Topic: Replace Block Lisp (Read 2447 times)
0 Members and 1 Guest are viewing this topic.
PM
Guest
Replace Block Lisp
«
on:
January 17, 2023, 05:46:02 AM »
Hi, I have two codes . One replace the block attributes and the other syntonize attributes
I found the second code
https://www.theswamp.org/index.php?topic=40756.0
is ronjonp post.
This two codes works fine , but I need help to join them to work as one code not two.
Code - Auto/Visual Lisp:
[Select]
(
defun
c:blk
-
mmst
(
/
master rl ss i en ed bn
)
(
while
(
not
master
)
(
and
(
princ
"
\n
Select MASTER Replacement BLOCK: "
)
(
setq
ss
(
ssget
(
list
(
cons
0
"INSERT"
)
)
)
)
(
=
(
sslength
ss
)
1
)
(
setq
master
(
strcase
(
cdr
(
assoc
2
(
entget
(
ssname
ss
0
)
)
)
)
)
)
)
)
(
princ
(
strcat
"
\n
"
master
)
)
(
while
(
and
(
princ
"
\n
Select BLOCKs To Replace: "
)
(
setq
ss
(
ssget
(
list
(
cons
0
"INSERT"
)
)
)
)
)
(
setq
i
0
)
(
while
(
setq
en
(
ssname
ss i
)
)
(
setq
ed
(
entget
en
)
bn
(
strcase
(
cdr
(
assoc
2
ed
)
)
)
)
(
cond
(
(
=
bn master
)
)
(
(
member
bn rl
)
)
(
(
setq
rl
(
cons
bn rl
)
)
)
)
(
setq
i
(
1+
i
)
)
)
)
(
foreach
e rl
(
and
(
setq
ss
(
ssget
"X"
(
list
(
cons
0
"INSERT"
)
(
cons
2
e
)
)
)
)
(
princ
(
strcat
"
\n
"
e
)
)
(
setq
i
0
)
(
while
(
setq
en
(
ssname
ss i
)
)
(
setq
ed
(
entget
en
)
)
(
entmod
(
subst
(
cons
2
master
)
(
assoc
2
ed
)
ed
)
)
(
setq
i
(
1+
i
)
)
)
)
)
(
command
"_.REGEN"
)
(
prin1
)
)
And ronjonp post
Code - Auto/Visual Lisp:
[Select]
(
defun
c:attsync2
(
/
_name _gettatts _lst atts e name ss
)
(
defun
_lst
(
ss
/
e n out
)
(
setq
n
-
1
)
(
if
(
=
(
type
ss
)
'pickset
)
(
while
(
setq
e
(
ssname
ss
(
setq
n
(
1+
n
)
)
)
)
(
setq
out
(
cons
(
vlax
-
ename
->
vla-object
e
)
out
)
)
)
)
)
(
defun
_attpositions
(
block
/
att result
)
(
foreach
att
(
vlax-invoke
block 'getattributes
)
(
setq
result
(
cons
(
list
(
vla-get-handle
att
)
(
vlax-get
att 'insertionpoint
)
(
vlax-get
att 'textalignmentpoint
)
)
result
)
)
)
)
(
defun
_name
(
b
)
(
cond
(
(
vlax-property-available-p
b 'effectivename
)
(
vla
-
get
-
effectivename b
)
)
(
(
vlax-property-available-p
b 'name
)
(
vla-get-name
b
)
)
)
)
(
if
(
and
(
setq
e
(
car
(
entsel
"
\n
Select block to sync: "
)
)
)
(
setq
name
(
_name
(
vlax
-
ename
->
vla-object
e
)
)
)
(
setq
ss
(
ssget
"_x"
(
list
(
cons
0
"insert"
)
)
)
)
)
(
progn
(
foreach
x
(
_lst ss
)
(
and
(
eq
(
_name x
)
name
)
(
setq
atts
(
cons
(
_attpositions x
)
atts
)
)
)
)
(
command
"._attsync"
"_s"
e
"_yes"
)
(
foreach
x
(
apply
'
append
atts
)
(
if
(
and
(
setq
e
(
handent
(
car
x
)
)
)
(
setq
e
(
vlax
-
ename
->
vla-object
e
)
)
)
(
progn
(
vl
-
catch
-
all
-
apply
'
vlax-put
(
list
e 'insertionpoint
(
cadr
x
)
)
)
(
vl
-
catch
-
all
-
apply
'
vlax-put
(
list
e 'textalignmentpoint
(
caddr
x
)
)
)
)
)
)
)
)
(
princ
)
)
Thanks
Logged
ribarm
Gator
Posts: 3272
Marko Ribar, architect
WWW
Re: Replace Block Lisp
«
Reply #1 on:
January 17, 2023, 08:12:09 AM »
Unchecked, but should work...
Code - Auto/Visual Lisp:
[Select]
(
defun
c:blk
-
mmst
+
attsync
(
/
_lst _attpositions _name master rl ss i en ed bn atts e name
)
(
vl-load-com
)
(
defun
_lst
(
ss
/
e n out
)
(
setq
n
-
1
)
(
if
(
=
(
type
ss
)
(
quote
pickset
)
)
(
while
(
setq
e
(
ssname
ss
(
setq
n
(
1+
n
)
)
)
)
(
setq
out
(
cons
(
vlax
-
ename
->
vla-object
e
)
out
)
)
)
)
)
(
defun
_attpositions
(
block
/
att result
)
(
foreach
att
(
vlax-invoke
block
(
quote
getattributes
)
)
(
setq
result
(
cons
(
list
(
vla-get-handle
att
)
(
vlax-get
att
(
quote
insertionpoint
)
)
(
vlax-get
att
(
quote
textalignmentpoint
)
)
)
result
)
)
)
)
(
defun
_name
(
b
)
(
cond
(
(
vlax-property-available-p
b
(
quote
effectivename
)
)
(
vla
-
get
-
effectivename b
)
)
(
(
vlax-property-available-p
b
(
quote
name
)
)
(
vla-get-name
b
)
)
)
)
(
while
(
not
master
)
(
and
(
princ
"
\n
Select MASTER Replacement BLOCK: "
)
(
setq
ss
(
ssget
(
list
(
cons
0
"INSERT"
)
)
)
)
(
=
(
sslength
ss
)
1
)
(
setq
master
(
strcase
(
cdr
(
assoc
2
(
entget
(
ssname
ss
0
)
)
)
)
)
)
)
)
(
princ
(
strcat
"
\n
"
master
)
)
(
while
(
and
(
princ
"
\n
Select BLOCKs To Replace: "
)
(
setq
ss
(
ssget
(
list
(
cons
0
"INSERT"
)
)
)
)
)
(
setq
i
0
)
(
while
(
setq
en
(
ssname
ss i
)
)
(
setq
ed
(
entget
en
)
bn
(
strcase
(
cdr
(
assoc
2
ed
)
)
)
)
(
cond
(
(
=
bn master
)
)
(
(
member
bn rl
)
)
(
(
setq
rl
(
cons
bn rl
)
)
)
)
(
setq
i
(
1+
i
)
)
)
)
(
foreach
e rl
(
and
(
setq
ss
(
ssget
"_X"
(
list
(
cons
0
"INSERT"
)
(
cons
2
e
)
)
)
)
(
princ
(
strcat
"
\n
"
e
)
)
(
setq
i
0
)
(
while
(
setq
en
(
ssname
ss i
)
)
(
setq
ed
(
entget
en
)
)
(
entmod
(
subst
(
cons
2
master
)
(
assoc
2
ed
)
ed
)
)
(
setq
i
(
1+
i
)
)
)
)
)
(
command
"_.REGEN"
)
(
if
(
and
(
setq
e
(
car
(
entsel
"
\n
Select block to sync: "
)
)
)
(
setq
name
(
_name
(
vlax
-
ename
->
vla-object
e
)
)
)
(
setq
ss
(
ssget
"_X"
(
list
(
cons
0
"INSERT"
)
)
)
)
)
(
progn
(
foreach
x
(
_lst ss
)
(
and
(
eq
(
_name x
)
name
)
(
setq
atts
(
cons
(
_attpositions x
)
atts
)
)
)
)
(
command
"._attsync"
"_s"
e
"_yes"
)
(
foreach
x
(
apply
(
function
append
)
atts
)
(
if
(
and
(
setq
e
(
handent
(
car
x
)
)
)
(
setq
e
(
vlax
-
ename
->
vla-object
e
)
)
)
(
progn
(
vl
-
catch
-
all
-
apply
(
function
vlax-put
)
(
list
e
(
quote
insertionpoint
)
(
cadr
x
)
)
)
(
vl
-
catch
-
all
-
apply
(
function
vlax-put
)
(
list
e
(
quote
textalignmentpoint
)
(
caddr
x
)
)
)
)
)
)
)
)
(
princ
)
)
Logged
Marko Ribar, d.i.a.
(graduated engineer of architecture)
M.R. on Youtube
PM
Guest
Re: Replace Block Lisp
«
Reply #2 on:
January 17, 2023, 11:09:11 AM »
Thanks ribarm
Logged
AVCAD
Newt
Posts: 29
Re: Replace Block Lisp
«
Reply #3 on:
August 01, 2023, 09:15:39 AM »
Is there any way to make this look at real block names not the *U ones for dynamic blocks.
I need to replace blocks that were not dynamic with new dynamic blocks?
Thanks in advance!
Logged
BIGAL
Swamp Rat
Posts: 1409
40 + years of using Autocad
Re: Replace Block Lisp
«
Reply #4 on:
August 05, 2023, 12:21:13 AM »
When you get a "*U34" block you can get its property "Effectivename" using VL code.
Logged
A man who never made a mistake never made anything
cmwade77
Swamp Rat
Posts: 1443
Re: Replace Block Lisp
«
Reply #5 on:
August 07, 2023, 05:13:40 PM »
Just as a heads up, AutoCAD 2024 has a command called BlockReplace that does this natively.
Logged
Print
Pages: [
1
] |
Go Up
« previous
next »
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
Replace Block Lisp
