Author Topic: Replace Block Lisp  (Read 190 times)

0 Members and 1 Guest are viewing this topic.

PM

  • Bull Frog
  • Posts: 403
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]
  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.    (and (princ "\nSelect BLOCKs To Replace:   ")
  11.         (setq ss (ssget (list (cons 0 "INSERT")))))
  12.    (setq i 0)
  13.    (while (setq en (ssname ss i))
  14.           (setq ed (entget en)
  15.                 bn (strcase (cdr (assoc 2 ed))))
  16.           (cond ((= bn master))
  17.                 ((member bn rl))
  18.                 ((setq rl (cons bn rl))))
  19.           (setq i (1+ i))))
  20.  
  21.  (foreach e rl
  22.    (and (setq ss (ssget "X" (list (cons 0 "INSERT")
  23.                                   (cons 2 e))))
  24.         (princ (strcat "\n" e))
  25.         (setq i 0)
  26.         (while (setq en (ssname ss i))
  27.                (setq ed (entget en))
  28.                (entmod (subst (cons 2 master) (assoc 2 ed) ed))
  29.                (setq i (1+ i)))))
  30.  
  31.  (command "_.REGEN")
  32.  (prin1))
  33.  

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

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

:)

M.R. on Youtube

PM

  • Bull Frog
  • Posts: 403
Re: Replace Block Lisp
« Reply #2 on: January 17, 2023, 11:09:11 AM »
Thanks ribarm