AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

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

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