;;;Elise Moss
;;;Moss Designs
;;;www.mossdesigns.com
;;;November 2004
;;;This routine allows you to substitute one block for another block

(defun c:subblk	()
;;; get list of blocks in the drawing
  (setq blocklist nil)
  (setq bentity (tblnext "BLOCK" T))

  (while (/= bentity nil)

    (setq bname (cdr (assoc 2 bentity)))
    (setq blocklist (append blocklist (list bname)))
    (setq bentity (tblnext "BLOCK"))
  )					;end while

					; sort the list in alphabetical order
  (setq blocklist (acad_strlsort blocklist))
					; print the blocklist
  (setq listlen (length blocklist))
  (setq list-item 0)
  (textscr)
  (princ "\nBlocks currently in the drawing")
  (princ "\n")
  (while (< list-item listlen)
    (princ (nth list-item blocklist))
    (princ "\n")
    (setq list-item (+ 1 list-item))
  )


					; first specify the block to replace

  (setq	newblock
	 (getstring
	   "\nEnter new block name or ENTER to select a block not in the current drawing: "
	 )
  )

  (if (= newblock "")
    (progn
      (setq flag "T")
      (setq newblock (getfiled "Select block to substitute" "" "dwg" 8))
    )					; end progn
  )					;end if
					; next we select the block to be replaced
  (princ "\nSelect block(s) to be replaced: ")
  (setq oldblockset (ssget))
  (setq blockrepno (sslength oldblockset))
  (setq index 0)
  (while (< index blockrepno)

    (setq oldblock (ssname oldblockset index))
    (setq old-list (entget oldblock))
    ;; get info to replace block
    ;;need insertion point
    (setq ins-pt (cdr (assoc 10 old-list)))
    ;; need layer
    (setq lay (cdr (assoc 8 old-list)))
    ;;get scale
    (setq scax (cdr (assoc 41 old-list)))
    (setq scay (cdr (assoc 42 old-list)))
    ;;get rotation
    (setq rotang (cdr (assoc 50 old-list)))
    (setq rotang (cvunit rotang "radian" "degree"))
    ;;set layer to desired layer
    (command "-layer" "set" lay "")
    ;;insert the new block
    (command "-insert" newblock ins-pt scax scay rotang)
    ;;rease the old block
    (command "erase" oldblock "")
    (setq index (+ 1 index))
  )					;end while


)					;end edfun

(princ "\nType 'subblk' to replace\substitute a block.")