AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

"I thought you guys might want to use this lisp routine I made. It is used for replacing old blocks with a new block, like updating old drawings to new standards".

Rodney Nelson

;CODING STARTS HERE
;;
;; Function to replace selected block with another...
;; Another Bad Ass thing by Rodney Nelson
;;

(defun c:blkswitch (/ BENT BENTL BNAME X ANG SS1 N1 D IND ENT XVAL ELIST BP)

(initerr)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "undo" "be")
(setq BENT (entsel "\nPick old block you want to replace: "))
(if (null BENT)
(while (null BENT)
(princ "\nNothing selected, Pick old block you want to replace or press ^C to quit: ")
(setq BENT (entsel))
);while
);if
(setq BENTL (entget (car BENT)))
(setq BNAME (cdr (assoc 2 BENTL)))
(if (= BNAME NIL)
(progn
(alert "Entity selected is not a block. ")
);progn
(progn

(setq newblk (entsel "\nPick new block to replace old: "))
(if (null newblk)
(while (null newblk)
(princ "\nNothing selected, Pick new block to replace old or press ^C to quit: ")
(setq newblk (entsel))
);while
);if
(setq newblkl (entget (car newblk)))
(setq newblkname (cdr (assoc 2 newblkl)))
(if (= newblkname NIL)
(progn
(alert "Entity selected is not a block. ")
);progn
(progn

(setq newblklay (cdr (assoc 8 newblkl)))
(prompt "\nSearching database for blocks...")
(setq SS1 (ssget "x" (list (cons 2 BNAME))))
(setq N1 (sslength SS1))
(setq D "t")
(while D
(setq IND (- N1 1))
(setq ENT (ssname SS1 IND))
(setq edat (entget (ssname SS1 IND)))
(entdel (ssname SS1 IND))
(setq blklay (cdr (assoc 8 edat)))
(setq inspt (cdr (assoc 10 edat)))
(setq xscl (cdr (assoc 41 edat)))
(setq yscl (cdr (assoc 42 edat)))
(setq blkrot (cdr (assoc 50 edat)))
(setvar "clayer" newblklay)
(command "-insert" (strcat blockpath newblkname) inspt blkscale "" (rtd blkrot))
(setq N1 (- N1 1))
(if (= N1 0)
(setq D NIL)
);if
);while
);progn
);if

(prompt (strcat "\nAll done! " (rtos (sslength SS1) 2 0) " <" BNAME "> blocks were replaced with <" newblkname "> blocks"))
);progn
);if

(command "undo" "e")
(reset)
(princ)
);defun blkswitch

(defun rtd (radval / )
(* radval (/ 180.0 PI))
)
;;
;; Global error checking routine
;;

(defun error()
(prompt "\nGlobal Error Trap Loaded")
(princ)
);defun

;;;*error checking routine
;;;
(defun initerr ()
(setq oldlayer (getvar "clayer"))
(setq oldsnap (getvar "osmode"))
(setq oldpick (getvar "pickbox"))
(setq oldorth (getvar "orthomode"))
(setq echo (getvar "cmdecho"))
(setq olddia (getvar "attdia"))
(setq oldfile (getvar "filedia"))
(setq oldang (getvar "snapang"))
(setq temperr *error*)
(setq *error* trap)
(princ)
)
;;;*
(defun trap (errmsg)
(command nil nil nil)
(if (not
(member errmsg
'("console break" "Function Cancelled"))
)
(princ (strcat "\nError: " errmsg))
)
(setvar "clayer" oldlayer)
(setvar "menuecho" 0)
(setvar "highlight" 1)
(setvar "osmode" oldsnap)
(setvar "pickbox" oldpick)
(setvar "orthomode" oldorth)
(setvar "cmdecho" echo)
(setvar "attdia" olddia)
(setvar "filedia" oldfile)
(setvar "snapang" oldang)
(princ "\nError Detected, Resetting Original Enviroment ")
(terpri)
(setq *error* temperr)
(princ)
)
;;;
(defun reset ()
(setq *error* temperr)
(setvar "clayer" oldlayer)
(setvar "menuecho" 0)
(setvar "highlight" 1)
(setvar "osmode" oldsnap)
(setvar "pickbox" oldpick)
(setvar "orthomode" oldorth)
(setvar "cmdecho" echo)
(setvar "attdia" olddia)
(setvar "filedia" oldfile)
(setvar "snapang" oldang)
(princ)
)
;;;
(princ)
;CODING ENDS HERE

The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website