Block Toggle Lisp

[mtubbs]

I need some help. I need a lisp that replaces one block for another and vise versa. So, my drawing would have blocks A,B,C,D and 1,2,3,4 inserted in it. I need a toogle, that when for instance block "B" is sleected by picking, it replaces it with block "2". And if block "2" is selected it replaced it with block "B". And it would do the same for the others below:

A swaps with 1
B swaps with 2
C swaps with 3
D swaps with 4

and

1 swaps with A
2 swaps with B
3 swaps with C
4 swaps with D

Any help is appreciated, I'm not sure how to start this

[ccowgill]

could you just use a dynamic block with visibility states, so when you select the block, you just change the visibility state to toggle between the two. or are you wanting to do all instances within the drawing?

[mtubbs]

I thought of doing that, but these blocks will have attribute values that will need to be carried over. The only way that I could figure that out with dynamic features is to have two attributes that have visibility states. The reason is that block "A" attribute needs to be on layer "green" and block "1" attribute on layer "blue". Is that confusing? And I don't want to change all blocks in the drawing, just the one picked.

[Tom Beauford]

Here's an old one you can easily modify. Just change the block names. It doesn't affect the block attributes. It first checks to see if the block is in the drawing, then replaces the block and layer name in the insert.

; Toggles Whether or not Trees are to be Removed
; BY: TOM BEAUFORD
; LEON COUNTY PUBLIC WORKS ENGINEERING SECTION
(defun C:TBR (/ en ed old_blk pt led le)
  (setq en (entsel "\nSelect Entity: "))
  (if en
   (progn
    (setq ed (entget (car en))
          old_blk(cdr(assoc 2 ed))
          pt(getvar "VIEWCTR")
     )
    (setvar "cmdecho" 0)
    (if(not(tblsearch "layer" "Removedtrees"))
      (VL-CMDF "-layer" "new" "Removedtrees" "c" 253 "Removedtrees" ""))
    (if(not(tblsearch "block" "dtree20TBR"))
      (progn
        (VL-CMDF "insert" "dtree20tbr" pt "10000" "10000" "0")
        (VL-CMDF "erase" "L" "")))
    (if(not(tblsearch "block" "ctree20tbr"))
      (progn
        (VL-CMDF "insert" "ctree20tbr" pt "10000" "10000" "0")
        (VL-CMDF "erase" "L" "")))
    (cond
      ((= old_blk "DTREE20")
        (setq ed (subst(cons 2 "dtree20tbr")(assoc 2 ed) ed)
                 ed (subst(cons 8 "Removedtrees")(assoc 8 ed) ed)
        ))
      ((= old_blk "CTREE20")
        (setq ed (subst(cons 2 "ctree20tbr")(assoc 2 ed) ed)
                 ed (subst(cons 8 "Removedtrees")(assoc 8 ed) ed)
        ))
      ((= old_blk "dtree20tbr")
        (setq ed (subst(cons 2 "DTREE20")(assoc 2 ed) ed)
                 ed (subst(cons 8 "s_dtrees")(assoc 8 ed) ed)
        ))
      ((= old_blk "ctree20tbr")
        (setq ed (subst(cons 2 "CTREE20")(assoc 2 ed) ed)
                 ed (subst(cons 8 "s_ctrees")(assoc 8 ed) ed)
         ))
       (t (progn
            (princ "\nMust select a ctree20, dtree20, ctree20tbr or dtree20tbr!  Not a ")
            (princ old_blk)
       )  )
    )
    (entmod ed)
   );end progn
   (princ "\nNothing selected")
  );end if
  (princ)
)

[mtubbs]

Thanks Tom...this is working great for me, but now I have an additional issue with one of the blocks. One of the blocks to replace has a dynamic stretch parameter so it is Anonymous. Can old_blk equal *U to perform the block swap? How would I do this?

Here is the code so far:

(defun C:blocktog (/ en ed old_blk pt led le)
  (setq en(entsel "\nSelect Entity: "))
  (if en
   (progn
    (setq ed (entget (car en))
          old_blk(cdr(assoc 2 ed))
          pt(getvar "VIEWCTR")
     )
    (setvar "cmdecho" 0)
    (setvar "mirrtext" 1)
    (if(not(tblsearch "layer" "G-LITE"))
      (Command "-layer" "new" "G-LITE" "c" 4 "G-LITE" ""))
    (if(not(tblsearch "layer" "G-HEAVY"))
      (Command "-layer" "new" "G-HEAVY" "c" 6 "G-HEAVY" ""))
    (if(not(tblsearch "block" "CONT-TAG2"))
      (progn
        (Command "-insert" "CONT-TAG2" pt "12" "12" "0" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "CONT-TAG2-E"))
      (progn
        (Command "-insert" "CONT-TAG2-E" pt "12" "12" "0" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "ID_KEY2"))
      (progn
        (Command "-insert" "ID_KEY2" pt "12" "12" "0" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "ID_KEY2-E"))
      (progn
        (Command "-insert" "ID_KEY2-E" pt "12" "12" "0" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "HU-INSUL3"))
      (progn
        (Command "-insert" "HU-INSUL3" pt "12" "12" "0" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "HU-INSUL3-E"))
      (progn
        (Command "-insert" "HU-INSUL3-E" pt "12" "12" "0" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "HU-TGM_R"))
      (progn
        (Command "-insert" "HU-TGM_R" pt "12" "12" "0" "" "" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "HU-TGM_R-E"))
      (progn
        (Command "-insert" "HU-TGM_R-E" pt "12" "12" "0" "" "" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "HU-TGM_L"))
      (progn
        (Command "-insert" "HU-TGM_L" pt "12" "12" "0" "" "" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "HU-TGM_L-E"))
      (progn
        (Command "-insert" "HU-TGM_L-E" pt "12" "12" "0" "" "" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "CUPS_ID2"))
      (progn
        (Command "-insert" "CUPS_ID2" pt "12" "12" "0" "" "" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "CUPS_ID2-E"))
      (progn
        (Command "-insert" "CUPS_ID2-E" pt "12" "12" "0" "" "" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "SUD_ID3"))
      (progn
        (Command "-insert" "SUD_ID3" pt "12" "12" "0" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "SUD_ID3-E"))
      (progn
        (Command "-insert" "SUD_ID3-E" pt "12" "12" "0" "")
        (Command "erase" "L" "")))
    (cond
      ((= old_blk "CONT-TAG2")
        (setq ed (subst(cons 2 "CONT-TAG2-E")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-LITE")(assoc 8 ed) ed)
        ))
      ((= old_blk "CONT-TAG2-E")
        (setq ed (subst(cons 2 "CONT-TAG2")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-HEAVY")(assoc 8 ed) ed)
         ))
      ((= old_blk "ID_KEY2")
        (setq ed (subst(cons 2 "ID_KEY2-E")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-LITE")(assoc 8 ed) ed)
        ))
      ((= old_blk "ID_KEY2-E")
        (setq ed (subst(cons 2 "ID_KEY2")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-HEAVY")(assoc 8 ed) ed)
        ))
      ((= old_blk "HU-INSUL3")
        (setq ed (subst(cons 2 "HU-INSUL3-E")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-LITE")(assoc 8 ed) ed)
        ))
      ((= old_blk "HU-INSUL3-E")
        (setq ed (subst(cons 2 "HU-INSUL3")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-HEAVY")(assoc 8 ed) ed)
         ))
      ((= old_blk "HU-TGM_R")
        (setq ed (subst(cons 2 "HU-TGM_R-E")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-LITE")(assoc 8 ed) ed)
        ))
      ((= old_blk "HU-TGM_R-E")
        (setq ed (subst(cons 2 "HU-TGM_R")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-HEAVY")(assoc 8 ed) ed)
         ))
      ((= old_blk "HU-TGM_L")
        (setq ed (subst(cons 2 "HU-TGM_L-E")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-LITE")(assoc 8 ed) ed)
        ))
      ((= old_blk "HU-TGM_L-E")
        (setq ed (subst(cons 2 "HU-TGM_L")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-HEAVY")(assoc 8 ed) ed)
         ))
      ((= old_blk "CUPS_ID2")
        (setq ed (subst(cons 2 "CUPS_ID2-E")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-LITE")(assoc 8 ed) ed)
        ))
      ((= old_blk "CUPS_ID2-E")
        (setq ed (subst(cons 2 "CUPS_ID2")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-HEAVY")(assoc 8 ed) ed)
         ))
      ((= old_blk "SUD_ID3")
        (setq ed (subst(cons 2 "SUD_ID3-E")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-LITE")(assoc 8 ed) ed)
        ))
      ((= old_blk "SUD_ID3-E")
        (setq ed (subst(cons 2 "SUD_ID3")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-HEAVY")(assoc 8 ed) ed)
         ))
       (t (progn
            (princ "\nMust select a SUD, CUPS, TGM, Keynote or Insulation symbol/tag!  Not a ")
            (princ old_blk)
       )  )
   )
    (entmod ed)
   );end progn
   (princ "\nNothing selected")
  );end if
  (Command "attsync" "N"  "*")
  (Command "regen")
  (princ)
)

[Tom Beauford]

Check out: http://usa.autodesk.com/adsk/servlet...linkID=9240615
UnAnon.lsp is what I use, but have not called it fromm another routine, nor have I tested it on dynamic blocks.

[andrea.andreetti]

;;		SWAPBlock			;;
;;	By: Andrea Andreetti  2009-02-12	;;
;;	Swap block from 2 list			;;

(defun c:swapblock (/ block_list1 block_list2 sblock blocklist doc vlpos itema itemb)
  (setq sblock nil)
  (setq block_list1 (mapcar 'strcase '("A" "B" "C" "D" "E")))
  (setq block_list2 (mapcar 'strcase '("1" "2" "3" "4" "5")))
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for blk (vla-get-blocks doc)
    (if (= (vla-get-isxref blk) :vlax-false)
      (setq blocklist (append blocklist (list (vla-get-name blk))))
    )
  )
  (while (not sblock)
    (setq sblock (car (entsel "\nSelect your block...")))
  )
  (setq sblock_vla (vlax-ename->vla-object sblock))
  (setq vlatype (vla-get-objectname sblock_vla))
  (if (eq vlatype "AcDbBlockReference")
    (progn (setq vlaname (strcase (vla-get-name sblock_vla)))
           (setq vlpos (vl-position vlaname block_list1))
           (if (not vlpos)
             (setq vlpos (vl-position vlaname block_list2))
           )
           (if vlpos
             (progn (setq itema (nth vlpos block_list1))
                    (setq itemb (nth vlpos block_list2))
             )
           )
           (if (and (member itema (mapcar 'strcase blocklist))
                    (member itemb (mapcar 'strcase blocklist))
               )
             (if (eq itema vlaname)
               (vla-put-name sblock_vla itemb)
               (vla-put-name sblock_vla itema)
             )
           )
    )
  )
  (if doc
    (progn (vlax-release-object doc) (setq doc nil))
  )
)

It swap block based from 2 list.
It detect the if it is an XREF
and keep all proprety.

[mtubbs]

I found a way to get around the dynamic block issue by swapping based in layer. Now, my issue is getting the dynamic properties from the old block and adding it to the new one. Is anyone out there that can help?

updated code:

(defun C:ct-tog (/ en ed old_blk pt led le)
  (setq en(entsel "\nSelect Continuation Tag: "))
  (if en
   (progn
    (setq ed (entget (car en))
          old_blk(cdr(assoc 8 ed))
          pt(getvar "VIEWCTR")
     )
    (setvar "cmdecho" 0)
    (setvar "mirrtext" 1)
    (if(not(tblsearch "layer" "G-LITE"))
      (Command "-layer" "new" "G-LITE" "c" 4 "G-LITE" ""))
    (if(not(tblsearch "layer" "G-HEAVY"))
      (Command "-layer" "new" "G-HEAVY" "c" 6 "G-HEAVY" ""))
    (if(not(tblsearch "layer" "G-HEAVY"))
      (Command "-layer" "new" "G-SYMBOL" "c" 6 "G-SYMBOL" ""))
    (if(not(tblsearch "block" "CONT-TAG2"))
      (progn
        (Command "-insert" "CONT-TAG2" pt "12" "12" "0" "")
        (Command "erase" "L" "")))
    (if(not(tblsearch "block" "CONT-TAG2-E"))
      (progn
        (Command "-insert" "CONT-TAG2-E" pt "12" "12" "0" "")
        (Command "erase" "L" "")))
    (cond
      ((= old_blk "G-HEAVY")
        (setq ed (subst(cons 2 "CONT-TAG2-E")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-LITE")(assoc 8 ed) ed)
        ))
      ((= old_blk "G-SYMBOL")
        (setq ed (subst(cons 2 "CONT-TAG2-E")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-LITE")(assoc 8 ed) ed)
        ))
      ((= old_blk "G-LITE")
        (setq ed (subst(cons 2 "CONT-TAG2")(assoc 2 ed) ed)
                 ed (subst(cons 8 "G-HEAVY")(assoc 8 ed) ed)
        ))
       (t (progn
            (princ "\nTag must be on layer G-HEAVY or G_SYMBOL!  Not on layer ")
            (princ old_blk)
       )  )
   )
    (entmod ed)
   );end progn
   (princ "\nNothing selected")
  );end if
  (Command "attsync" "N"  "*")
  (Command "regen")
  (princ)
)

[mtubbs]

;;		SWAPBlock			;;
;;	By: Andrea Andreetti  2009-02-12	;;
;;	Swap block from 2 list			;;

(defun c:swapblock (/ block_list1 block_list2 sblock blocklist doc vlpos itema itemb)
  (setq sblock nil)
  (setq block_list1 (mapcar 'strcase '("A" "B" "C" "D" "E")))
  (setq block_list2 (mapcar 'strcase '("1" "2" "3" "4" "5")))
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for blk (vla-get-blocks doc)
    (if (= (vla-get-isxref blk) :vlax-false)
      (setq blocklist (append blocklist (list (vla-get-name blk))))
    )
  )
  (while (not sblock)
    (setq sblock (car (entsel "\nSelect your block...")))
  )
  (setq sblock_vla (vlax-ename->vla-object sblock))
  (setq vlatype (vla-get-objectname sblock_vla))
  (if (eq vlatype "AcDbBlockReference")
    (progn (setq vlaname (strcase (vla-get-name sblock_vla)))
           (setq vlpos (vl-position vlaname block_list1))
           (if (not vlpos)
             (setq vlpos (vl-position vlaname block_list2))
           )
           (if vlpos
             (progn (setq itema (nth vlpos block_list1))
                    (setq itemb (nth vlpos block_list2))
             )
           )
           (if (and (member itema (mapcar 'strcase blocklist))
                    (member itemb (mapcar 'strcase blocklist))
               )
             (if (eq itema vlaname)
               (vla-put-name sblock_vla itemb)
               (vla-put-name sblock_vla itema)
             )
           )
    )
  )
  (if doc
    (progn (vlax-release-object doc) (setq doc nil))
  )
)

It swap block based from 2 list.
It detect the if it is an XREF
and keep all proprety.

How can this be modified so that is runs through the drawing and automaticly replaces the blocks without a selection (entsel)? I tried to accomplish this by calling (c:-blockreplace) into a lisp, but I can't get it to work.

(defun c:replace_blocks ()
   (if (tblsearch "block" "A")
          ((c:-blockreplace) "A" "1" "y"))
   )
)

[mtubbs]

I also tried this.

(defun c:replace_blocks ()
   (if (tblsearch "block" "A")
      (progn
          (setq bss (ssget "x" '((2 . "A")(410 . "Model"))))
          (subst(cons 2 "1")(assoc 2 bss) bss)
      )
   )
)

Help!