Topic: Replace Block Lisp

[PM]

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]

1. (defun c:blk-mmst (/ master rl ss i en ed bn)
2.  
3.  (while (not master)
4.         (and (princ "\nSelect MASTER Replacement BLOCK:   ")
5.              (setq ss (ssget (list (cons 0 "INSERT"))))
6.              (= (sslength ss) 1)
7.              (setq master (strcase (cdr (assoc 2 (entget (ssname ss 0))))))))
8.  (princ (strcat "\n" master))
9.  
10.  (while
11.    (and (princ "\nSelect BLOCKs To Replace:   ")
12.         (setq ss (ssget (list (cons 0 "INSERT")))))
13.    (setq i 0)
14.    (while (setq en (ssname ss i))
15.           (setq ed (entget en)
16.                 bn (strcase (cdr (assoc 2 ed))))
17.           (cond ((= bn master))
18.                 ((member bn rl))
19.                 ((setq rl (cons bn rl))))
20.           (setq i (1+ i))))
21.  
22.  (foreach e rl
23.    (and (setq ss (ssget "X" (list (cons 0 "INSERT")
24.                                   (cons 2 e))))
25.         (princ (strcat "\n" e))
26.         (setq i 0)
27.         (while (setq en (ssname ss i))
28.                (setq ed (entget en))
29.                (entmod (subst (cons 2 master) (assoc 2 ed) ed))
30.                (setq i (1+ i)))))
31.  
32.  (command "_.REGEN")
33.  (prin1))
34.  

And  ronjonp post

Code - Auto/Visual Lisp: [Select]

1.  
2.  
3. (defun c:attsync2 (/ _name _gettatts _lst atts e name ss)
4.   (defun _lst (ss / e n out)
5.     (setq n -1)
6.     (if (= (type ss) 'pickset)
7.       (while (setq e (ssname ss (setq n (1+ n)))) (setq out (cons (vlax-ename->vla-object e) out)))
8.     )
9.   )
10.   (defun _attpositions (block / att result)
11.     (foreach att (vlax-invoke block 'getattributes)
12.       (setq result (cons (list (vla-get-handle att)
13.                                (vlax-get att 'insertionpoint)
14.                                (vlax-get att 'textalignmentpoint)
15.                         )
16.                         result
17.                    )
18.       )
19.     )
20.   )
21.   (defun _name (b)
22.     (cond ((vlax-property-available-p b 'effectivename) (vla-get-effectivename b))
23.           ((vlax-property-available-p b 'name) (vla-get-name b))
24.     )
25.   )
26.   (if (and (setq e (car (entsel "\nSelect block to sync: ")))
27.            (setq name (_name (vlax-ename->vla-object e)))
28.            (setq ss (ssget "_x" (list (cons 0 "insert"))))
29.       )
30.     (progn (foreach x (_lst ss) (and (eq (_name x) name) (setq atts (cons (_attpositions x) atts))))
31.            (command "._attsync" "_s" e "_yes")
32.            (foreach x (apply 'append atts)
33.              (if (and (setq e (handent (car x))) (setq e (vlax-ename->vla-object e)))
34.                (progn (vl-catch-all-apply 'vlax-put (list e 'insertionpoint (cadr x)))
35.                       (vl-catch-all-apply 'vlax-put (list e 'textalignmentpoint (caddr x)))
36.                )
37.              )
38.            )
39.     )
40.   )
41.   (princ)
42. )
43.  

Thanks

[ribarm]

Unchecked, but should work...

Code - Auto/Visual Lisp: [Select]

1. (defun c:blk-mmst+attsync ( / _lst _attpositions _name master rl ss i en ed bn atts e name )
2.  
3.   (vl-load-com)
4.  
5.   (defun _lst ( ss / e n out )
6.     (setq n -1)
7.     (if (= (type ss) (quote pickset))
8.       (while (setq e (ssname ss (setq n (1+ n)))) (setq out (cons (vlax-ename->vla-object e) out)))
9.     )
10.   )
11.  
12.   (defun _attpositions ( block / att result )
13.     (foreach att (vlax-invoke block (quote getattributes))
14.       (setq result (cons (list (vla-get-handle att)
15.                                (vlax-get att (quote insertionpoint))
16.                                (vlax-get att (quote textalignmentpoint))
17.                         )
18.                         result
19.                    )
20.       )
21.     )
22.   )
23.  
24.   (defun _name ( b )
25.     (cond
26.       ( (vlax-property-available-p b (quote effectivename)) (vla-get-effectivename b) )
27.       ( (vlax-property-available-p b (quote name)) (vla-get-name b) )
28.     )
29.   )
30.  
31.   (while (not master)
32.          (and (princ "\nSelect MASTER Replacement BLOCK:   ")
33.               (setq ss (ssget (list (cons 0 "INSERT"))))
34.               (= (sslength ss) 1)
35.               (setq master (strcase (cdr (assoc 2 (entget (ssname ss 0))))))))
36.   (princ (strcat "\n" master))
37.  
38.   (while
39.     (and (princ "\nSelect BLOCKs To Replace:   ")
40.          (setq ss (ssget (list (cons 0 "INSERT")))))
41.     (setq i 0)
42.     (while (setq en (ssname ss i))
43.            (setq ed (entget en)
44.                  bn (strcase (cdr (assoc 2 ed))))
45.            (cond ((= bn master))
46.                  ((member bn rl))
47.                  ((setq rl (cons bn rl))))
48.            (setq i (1+ i))))
49.  
50.   (foreach e rl
51.     (and (setq ss (ssget "_X" (list (cons 0 "INSERT")
52.                                    (cons 2 e))))
53.          (princ (strcat "\n" e))
54.          (setq i 0)
55.          (while (setq en (ssname ss i))
56.                 (setq ed (entget en))
57.                 (entmod (subst (cons 2 master) (assoc 2 ed) ed))
58.                 (setq i (1+ i)))))
59.  
60.   (command "_.REGEN")
61.  
62.   (if (and (setq e (car (entsel "\nSelect block to sync: ")))
63.            (setq name (_name (vlax-ename->vla-object e)))
64.            (setq ss (ssget "_X" (list (cons 0 "INSERT"))))
65.       )
66.     (progn (foreach x (_lst ss) (and (eq (_name x) name) (setq atts (cons (_attpositions x) atts))))
67.            (command "._attsync" "_s" e "_yes")
68.            (foreach x (apply (function append) atts)
69.              (if (and (setq e (handent (car x))) (setq e (vlax-ename->vla-object e)))
70.                (progn (vl-catch-all-apply (function vlax-put) (list e (quote insertionpoint) (cadr x)))
71.                       (vl-catch-all-apply (function vlax-put) (list e (quote textalignmentpoint) (caddr x)))
72.                )
73.              )
74.            )
75.     )
76.   )
77.   (princ)
78. )
79.  

[PM]

Thanks ribarm