I need to do this (if possible):
-select several objects at once
-replace each of them with a (pre-defined) block
can you help me?
Reply to
Loading thread data ...
I wrote a LISP routine a while back that I use to eXCHNGe blocks. It helps if tou first have to have the New block in your drawing (or you can type it in as long as it's in your Search Patch).
And be carefull that the Original Block sizes match (ie: 1:1 before you insert them). Other wise you'll end up with different insert sizes.
Then select the existing blocks you want ot Exchange. It maintains your original Block insert Point, Scale and Layer.
You have two Options when you run the routine... 1: is to select the New Symbol via screen pick. 2: is to either accept a previous selected Block name... or type one in.
One thing though, now and the routine doesn't see that you have selected a file with the 1 option. I just rerun the routine and select 2 and you'll see that it did indeed find your screen selection. Or just reload the LSP file and try again....
Oh... and if your original symbol has an Atrribute, and you want to replace the same symbol with another having a different Attribute text, this will do that too...
Anyways... good luck and I hope this is what you need...
ps: watch out for Word Wrap issues on the lines....
O/______________________________________ cut here _________________________ 0\
;; Exchanges existing symbols for a User defined new ;; one. Routine Searches Autocad PATH defaults or ;; gets Blocks from Drawing Data Base.
; ERROR MESSAGE *********** (defun *error* ( s ) (setvar "clayer" curlyr) ;reset working layer (princ) (princ "\n ") (princ) (terpri) )
(defun dxf (code elist) (cdr (assoc code elist)) );dxf
; *
*** GET NEW SYMBOL OFF SCREEN **** ; *********************************** (defun screen_symb ( ) (princ "\n--> Use a WINDOW selection to Pick the NEW Symbol!! "newSymPickA" "))
(setq newSymPickC (getstring "\nType in the 'Replacement' Block name or Press 'Return Key' to use above: ")) (terpri) ; reset if space entered (if (= newSymPickC nil) (setq newAtt newSymPickA) (setq newAtt newSymPickC)) (if (= newSymPickC "") (setq newAtt newSymPickA) (setq newAtt newSymPickC)) )
((= newAtt nil) (setq newAtt (getstring "\nEnter REPLACEMENT Symbol name: ")) (terpri) (if (= newAtt nil) (exit)) ) ) newAtt
; **** Look for Existing Symbol File in DWG Data Base **** (setq BlkTst nil) (if (tblsearch "block" newAtt) (setq BlkTst "Y")(setq BlkTst "N") ) ;if
; **** Look for Existing Symbol File in Symbol Folder **** (setq refname (strcat newAtt ".dwg")) (setq fileok (findfile refname)) (setq FileTst nil) (if (not fileok) (setq FileTst "N")(setq FileTst "Y") ) ;if
; Now Check for Valide Block Name (Data Base or Folder) (if (and (= BlkTst "N") (= FileTst "N")) ((setq end_msg "WARNING - Check your spelling")(exit)) ) ;if
; valide file found... (if (= newAtt nil) (exit))
) ; manual_symb
; *** User Block Choice Selection *** (defun get-choice ( / a-1 a-2 w-1) (cond ((/= EntTyp nil) (setq a-1 (rtos EntTyp 5 0)) (setq a-2 (strcat "\nEnter a Number 1 = Screen Selection 2 = Manual Entry : ")) (princ "\n") (initget (+ 2 4)) (setq w-1 (getreal a-2)) (if (= nil w-1) (setq EntTyp EntTyp) (setq EntTyp w-1))) ((= EntTyp nil) (initget (+ 1 2 4)) (setq EntTyp (getreal "\nEnter a Number 1 = Screen Selection 2 = Manual Entry: ")) (princ "\n")) );cond EntTyp );defun
; *********************** *********************** *********************** ; *********************** **** PROGRAM START **** *********************** ; *********************** *********************** *********************** (defun C:XCHNG ( / end_msg cntr count AttrTxt ename elist newSymPick SymblPick )
(setvar "cmdecho" 0) (setq curlyr (getvar "clayer")) ; get current layer
; Symbol size IF selected from Block Folder (setq figscl (getvar "UserR1")) ; find Figure Scale factor (setq figscI (getvar "UserI1")) ; find Figure Scale factor (setq Inmm (getvar "USerI1")) ; find if Inches 1 or MM 0 (if (= Inmm 1) (setq figscal (/
figscl 25.4))) (if (= Inmm 0) (setq figscal figscl))
; set messages (setq end_msg "Total of entities replaced is: ") (setq cntr " - Symbol file NOT found!!!")
; User Block Choice Selection (get-choice)
(cond ((= EntTyp 1) (screen_symb) (setq SymblPick "S")) ((= EntTyp 2) (manual_symb) (setq SymblPick "M")) ) ;cond
; *** Now Choose Existing Blocks *** (princ) (setq newAtt (strcase newAtt)) ; Set Symbol Name to UPPERCASE (princ (strcat "\nValide Symbol file found... Now Choose Blocks to Change: "))
(setq existSymPick (ssget (list (cons 0 "insert")))) (setq count 0)
(while existSymPick (setq enameA (ssname existSymPick count) elistA (entget enameA) count (+ 1 count) ) ;setq (setq cntr (rtos count 2 0)) (setq Exinspt (dxf 10 elistA)) ;block insertion point (setq Exrotan (angtos (dxf 50 elistA))) ;block rotation angle (setq Exsymscl (dxf 41 elistA)) ;block scale WAS 43 (setq Exlyrnam (dxf 8 elistA)) ;block layer (setq Exsymnam (dxf -1 elistA)) ;block name (command "layer" "s" Exlyrnam "") ;set working layer - temp (entdel Exsymnam) ;delete existing symbol
;;; Check First Symbol Selection Type with NO Attribute (if (and (= SymblPick "M")(= AttrTxt nil)) (command "insert" newAtt Exinspt Exsymscl "" Exrotan) ;insert new symbol - MANUAL );if Manual with No Attribute (if (and (= SymblPick "S")(= AttrTxt nil)) (command "insert" newAtt Exinspt newAttscl "" Exrotan) ;insert new symbol - SCREEN );if Screen with No Attribute
;;; Check First Symbol Selection Type with Attribute ; Set New Attribute to First Picked Attribute (setq AttrTxtNew AttrTxt)
; First make sure we have 'something' for Attribute Text (if (= AttrTxt "") (setq AttrTxtNew ".") (setq AttrTxtNew AttrTxt) );if
;;; CANNOT determine IF a new Manual Symbol has Attribute or not so IGNORE! (if (and (= SymblPick "S")(/= AttrTxt nil)) (command "insert" newAtt Exinspt newAttscl "" Exrotan AttrTxtNew) ;SCREEN );if Screen with Attribute
(princ) ) ;while
; *** END *** (setvar "clayer" curlyr) ;reset working layer (princ)(terpri) ) ;end Defun
O/______________________________________ cut here _________________________ 0\
Reply to
Mr. B

PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here. All logos and trade names are the property of their respective owners.