I sent you a lisp about a week ago from
replacing old blocks with new ones. I made a revision to include replacing
blocks with attributes, and to replace the blocks but keep their original scale
factor. The blocks with attributes get inserted with the default value, but I
could change it to set the attributes to the value of the new blocks attribute.
One other thing that I changed that I think you should consider covering is the
(entselect) function I created. It is a very useful global function to use for
testing the object selection by the type of object and if you miss. It is
foolproof and will keep looping until you get correct selection. I just thought
you would find it interesting.
Sample call - (entselect "TEXT"
"you want to replace") - "TEXT" is kind of object that you
want to pick, "you want to replace" is the words that you want to be
prompted - will look like -> Select a TEXT, you want to replace: The variable
ENTITY is what you can use to get data (cdr (assoc 0 (entget (car ENTITY))))
Thanks, Rodney Nelson
;CODING STARTS HERE
;; Function to replace selected block with another...
;; By Rodney Nelson C.D. - AutoLISP programmer/Drafter/Designer, need help
;;rodneyn10@hotmail.com>
;;-------------------------------------------------------------------
;; BY : Rodney Nelson
;; CREATED : 01-05-02
;; REVISED : 02-22-02
;; DEFUN : BS
;; VERSION : 1.1
;; COMMENTS : revised to include block with attributes, insert new block at
original scale
;; OTHER : build in error handeler
;;===================================================================
(defun c:bs () (blkswitch))
(defun blkswitch (/ BENT BENTL BNAME X ANG
SS1 N1 D IND ENT XVAL ELIST BP)
(initerr)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "attdia" 0)
(setvar "attreq" 0)
(command "undo" "be")
(entselect "INSERT" "you want to replace with new")
(setq BENTL (entget (car ENTITY)))
(setq BNAME (cdr (assoc 2 BENTL)))
(if (= BNAME NIL)
(progn
(alert "Entity selected is not a block. ")
);progn
(progn
(entselect "INSERT" "to
replace old block")
(setq newblkl (entget (car ENTITY)))
(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" newblkname inspt xscl yscl (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))
)
;;===================================================================
;; Function is a front end Object Selection filter to help idiot proof some
routines...
;; By Rodney Nelson C.D. - AutoLISP programmer/Drafter/Designer, need help
<rodneyn10@hotmail.com>
;;-------------------------------------------------------------------
;; BY : Rodney Nelson
;; CREATED : 02-22-02
;; DEFUN : (entselect)
;; VERSION : 1.0
;; COMMENTS :
;; OTHER : sample call - (entselect "TEXT" "you want to
replace") - "TEXT" is kind
;; of object that you want to pick, "you want to replace" is the words
that you want to
;; be prompted - will look like -> Select a TEXT, you want to replace:
;; The variable ENTITY is what you can use to get data (cdr (assoc 0 (entget
(car ENTITY))))
;;===================================================================
(defun entselect (OBJECTTYPE ACTIONPROMPT)
(setq OBJECTNAME OBJECTTYPE)
(if (= OBJECTTYPE "INSERT") (setq OBJECTTYPE "BLOCK"))
(setq ENTITY nil)
(setq SELECTPROMPT (strcat "\nSelect a " OBJECTTYPE ", "
ACTIONPROMPT ": "))
(if (null ENTITY)
(and
(while (null ENTITY)
(setq ENTITY (entsel SELECTPROMPT))
(setq SELECTPROMPT (strcat "\nNothing selected, Pick a " OBJECTTYPE
", " ACTIONPROMPT " or <Esc> to quit: "))
);while
(while (/= OBJECTNAME (cdr (assoc 0 (entget (car ENTITY)))))
(setq ENTITY (entsel (strcat "\nObject selected not a " OBJECTTYPE
" , Try again or <Esc> to quit: ")))
(while (null ENTITY)
(setq ENTITY (entsel (strcat "\nNothing selected, Pick a " OBJECTTYPE
", " ACTIONPROMPT " or <Esc> to quit: ")))
);while
);while
);and
);if
(princ)
);defun entselect
;;===================================================================
;; Error checking routine
;;===================================================================
(defun error() ;load function
(prompt "\nGlobal Error Trap Loaded") ;inform user
(princ)
);defun
;;;*==========================================================
(defun initerr () ;Initialize Error Function
(setq oldlayer (getvar "clayer")) ;Save System Variables
(setq oldsnap (getvar "osmode"))
(setq oldpick (getvar "pickbox"))
(setq oldorth (getvar "orthomode"))
(setq echo (getvar "cmdecho"))
(setq olddia (getvar "attdia"))
(setq oldreq (getvar "attreq"))
(setq oldfile (getvar "filedia"))
(setq oldang (getvar "snapang"))
(setq temperr *error*) ;Save *error* Function
(setq *error* trap) ;Re-name *Error* Function
(princ) ;Exit Quietly
) ;defun
;;;*===========================================================
(defun trap (errmsg) ;If Error
(command nil nil nil) ;Cancel Everything
(if (not ;Check for Error Type
(member errmsg ;If not System Error
'("console break" "Function Cancelled")) ;User Cancelled
)
(princ (strcat "\nError: " errmsg)) ;Show Error Message
)
(setvar "clayer" oldlayer) ;Reset System Variables
(setvar "menuecho" 0)
(setvar "highlight" 1)
(setvar "osmode" oldsnap)
(setvar "pickbox" oldpick)
(setvar "orthomode" oldorth)
(setvar "cmdecho" echo)
(setvar "attdia" olddia)
(setvar "attreq" oldreq)
(setvar "filedia" oldfile)
(setvar "snapang" oldang)
(princ "\nError Detected, Resetting Original Enviroment ") ;Inform
User
(terpri)
(setq *error* temperr) ;Restore *Error* Function
(princ)
) ;defun
;;;*===========================================================
(defun reset () ;If no Error Restore Settings
(setq *error* temperr) ;Reset *Error* Function
(setvar "clayer" oldlayer) ;Reset System Variables
(setvar "menuecho" 0)
(setvar "highlight" 1)
(setvar "osmode" oldsnap)
(setvar "pickbox" oldpick)
(setvar "orthomode" oldorth)
(setvar "cmdecho" echo)
(setvar "attdia" olddia)
(setvar "attreq" oldreq)
(setvar "filedia" oldfile)
(setvar "snapang" oldang)
(princ)
) ;defun
;;;*======================================================
(princ)
;CODING ENDS HERE
|