;                                      MB - Match Block
;                          By Brian Forbes - http://www.autolisp.org/
;                              Free consulting and custom lisps!!
;
;  Permissions:
;    Permission is hereby granted to copy and modify this lisp.  It is provided "as is" by the author.
;    The authorship and url must remain with the copied function.  
;  Version:
;    1.0 - March 5, 2003
;  Explanation:
;    This function allows a user to match one block with another.  It also works with other objects.
;  Known bugs:
;    none

(defun c:mb ( / cme osm pt sample tsample ss count howmany cur isblock blk entnextcount centnexts) 
; Match by one object the properties of many objects - by Brian Forbes - http://www.autolisp.org/
; Also known as Match Block
; Similar to matchprop of autocad r14
; The property must exist in the object for it to be considered for changing (eg. 62 - color)
  (setq osm (getvar "osmode")) (setvar "osmode" 0)
  (setq pt (getpoint "Match by: ")) 
  (if (not (if pt (nentselp pt) nil)) 
    (c:mbprop)
    (progn
      (setq sample (entget (car (nentselp pt))))
      ; the following is for use with blocks with attributes -------------------------------
      (setq blk (ssname (ssget pt) 0))
      (if blk (setq isblock (if (= (cdr (assoc 0 (entget blk))) "INSERT") T nil)))
      (if (and isblock (entnext blk))
        (while (= (cdr (assoc 0 (entget (entnext blk)))) "ATTRIB")
          (setq blk (entnext blk) entnextcount (1+ (if entnextcount entnextcount 0)))
        ) ; while
      ) ; if isblock
      (setq blk (ssname (ssget pt) 0))
      (if (/= (cdr (assoc 0 (entget blk))) "INSERT") (setq blk nil))
      (if entnextcount (progn (princ " Attribute text detected: ") (princ entnextcount)))
      ; ------------------------------------------------------------------------------------
      (setq ss (ssget)) (setq num (sslength ss) count 0 howmany 0)
      (setq cme (getvar "cmdecho")) (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" cme)
      (while (or (<= (setq count (1+ count)) num) (= count nil))
        (setq cur (entget (ssname ss (1- count))))
        (if (= "INSERT" (cdr (assoc 0 cur)))
          (setq howmany (+ (matchent (entget blk) cur) howmany))
          (setq howmany (+ (matchent sample cur) howmany))
        )
        ; for attribs in blocks:
        (if (if extmtch
              (and blk (= (cdr (assoc 2 cur)) (if blk (cdr (assoc 2 (entget blk)))))) 
              (if blkucase
                (if blk (tstgrp (cdr (assoc 2 cur)) (cdr (assoc 2 (entget blk))) ) nil) 
                (if blk (tstgrp (strcase (cdr (assoc 2 cur))) (strcase (cdr (assoc 2 (entget blk)))) ) nil) 
              ) ; if blkucase
            ) ; if extmtch
          (progn
            (setq tmpenc entnextcount tsample (entget blk))
            (while (>= (setq tmpenc (1- tmpenc)) 0)
              (setq tsample (entget (entnext (cdar tsample))))
              (setq cur (entget (entnext (cdar cur))))
              (matchent tsample cur)
            ) ; while tmpenc
        )) ; if blocks are equal
      ) ; while count
  )) ; if & progn there is no point
  (setvar "osmode" osm)
  (if howmany (progn (princ "\nItems modified: ")(princ howmany)))
  (princ)
) ; Match By


(defun matchent (sample cur / count howmany togblk) ; by Brian Forbes - http://www.autolisp.org/ - for use with mb
  (setq count 0 howmany 0 togblk nil) ; togblk T - blocks redefined, togblk nil - blocks stay the same
  (while (< (setq count (1+ count)) 76)
    (if mbtext (if (= count 1) (setq count 2))) ; text
    (if togblk
      (if (= count 2) 
        (if (and (= "INSERT" (cdr (assoc 0 sample))) (= "INSERT" (cdr (assoc 0 cur)))) 
          nil
          (setq count 3)              ; Block name or attrib tag
        ) ; if inserts
      ) ; if count is 2
      (if (= count 2) (setq count 3))
    ) ; if togblk
    (if (= count 5) (setq count 6))   ; Hex handle
    (if (and (not mbpoints) (= count 10)) (setq count 37)) ; All points
    (if (and (not mbscale) (= count 41)) (setq count 44)) ; X, Y, & Z Scale
    (if (and (not mbangle) (= count 50)) (setq count 52)) ; Rotation Angle
    (if (car (assoc count sample))
      (if (car (assoc count cur)) (progn
        (setq cur (subst (assoc count sample) (assoc count cur) cur))
      )) ; if cur & progn
    ) ; if sample
  ) ; while count
  (if (entupd (cdr (assoc -1 (entmod cur)))) (setq howmany (1+ howmany)))
  howmany
)

(defun c:mbprop ( / ch) ; By Brian Forbes - http://www.autolisp.org/ 
  (princ "\nSelect MB's properties defaults to change, space to quit:")(textscr)
  (princ "\n1 - Text        <") (if mbtext (princ mbtext) (princ 0))     (princ "> Default: 0 = match")
  (princ "\n2 - Points      <") (if mbpoints (princ mbpoints) (princ 0)) (princ "> Default: 0 = no match")
  (princ "\n3 - Scale       <") (if mbscale (princ mbscale) (princ 0))   (princ "> Default: 0 = no match")
  (princ "\n4 - Angle       <") (if mbangle (princ mbangle) (princ 0))   (princ "> Default: 0 = no match")
  (princ "\n5 - Block def   <") (if togblk (princ togblk) (princ 0))     (princ "> Default: 0 = no match")
  (princ "\n6 - Exact match <") (if extmtch (princ extmtch) (princ 0))   (princ "> Default: 0 = test group match")
  (princ "\n7 - Block case  <") (if blkucase (princ blkucase) (princ 0)) (princ "> Default: 0 = block names upper case")
  (initget "1 2 3 4 5 6 7")
  (while (setq ch (getkword "\n : "))
    (if (= "1" ch) (if mbtext (setq mbtext nil) (setq mbtext 1))
    (if (= "2" ch) (if mbpoints (setq mbpoints nil) (setq mbpoints 1))
    (if (= "3" ch) (if mbscale (setq mbscale nil) (setq mbscale 1))
    (if (= "4" ch) (if mbangle (setq mbangle nil) (setq mbangle 1))
    (if (= "5" ch) (if togblk (setq togblk nil) (setq togblk 1))
    (if (= "6" ch) (if extmtch (setq extmtch nil) (setq extmtch 1))
    (if (= "7" ch) (if blkucase (setq blkucase nil) (setq blkucase 1))
    ))))))) ; ifs
    (initget "1 2 3 4 5 6 7")
  ) ; while
  (graphscr) (princ)
) ; c:mbprop


(defun tstgrp (tststr tstby / lists lenlists curlist lencurlist found1 found2 done)
; By Brian Forbes - http://www.autolisp.org/
  (setq lists (list ; change the following lines to match the blocks you have with attributes
    (list "BLOCK1" "BLOCK2" "BLOCK3")
    (list "BLOCK4" "BLOCK5" "BLOCK6")
  )) ; setq list
  (setq lenlists (length lists))
  (while (and (not done) (>= (setq lenlists (1- lenlists)) 0))
    (setq curlist (nth lenlists lists))
    (setq lencurlist (length curlist))
    (setq found1 nil found2 nil)
    (while (and (not done) (>= (setq lencurlist (1- lencurlist)) 0))
      (if (not found1) (progn
        (if (= tstby (nth lencurlist curlist)) (setq found1 T))
      )) ; if & progn
      (if (not found2) (progn
        (if (= tststr (nth lencurlist curlist)) (setq found2 T))
      )) ; if & progn
      (if (and found1 found2) (setq done T))
    ) ; nested while
  ) ; while done or lenlists
  (if done tststr)
) ; defun tstgrp