Leaderboard

I've uploaded 2 my programs to download section of cadtutor... I hope you'll find them useful... Here are links : Regards, Marko Ribar, d.i.a. (architect)

(defun c:test (/ xlApp xlBook xlSheet atsheet columnD Columnall row col cellValue ) (vl-load-com) (setq xlApp (vlax-get-or-create-object "Excel.Application")) (setq xlBook (vlax-get-property xlApp 'Sheets) xlSheet (vlax-get-property xlBook 'Item "Sheet1") atsheet (vlax-invoke-method xlSheet 'Activate) ) (setq ColumnD (vlax-get-property xlSheet 'Range "D:D")) (setq lastCell (vlax-invoke ColumnD 'Find "*" nil -4163 1 2 2) ; 'Fine what after lookin lookat SearchOrder SearchDirection ) ; xlfindlookin > xlComments = -4144, xlCommentsThreaded = -4184, xlFormulas = -4123, xlValues = -4163 ; xlLookAt > xlWhole = 1, xlPart = 2 ; XlSearchOrder > xlByRows = 1, xlByColumns = 2 ; XlSearchDirection > xlNext = 1, xlPrevious = 2 (if lastCell (progn (setq row (vlax-get lastCell 'Row)) (setq col (vlax-get lastCell 'Column)) (setq cellValue (vlax-get lastCell 'Value)) (if (numberp cellValue) (setq cellValue (rtos cellValue 2 2)) ) (princ (strcat "Last non-empty cell in column D is in row " (itoa row) ", column " (itoa col) ", with value: " "\"" cellValue "\"" ) ) ) (princ "No non-empty cell found in column D") ) (vlax-release-object columnD) (vlax-release-object lastCell) (vlax-release-object xlApp) (gc) (gc) (princ) ) 1. If you want to use this, you must change all values starting with xl~ to constants. Because that is a value known to excel only. not a value known to autolisp. Just think of it like this. (setq xlValue -4163) (setq xlWhole 1) ..... etc excel vba has this values in those variables already you can find it in microsoft pages. like this link https://learn.microsoft.com/en-us/office/vba/api/excel.xlfindlookin 2. there are two ways to find the last cell. forward way as you mentioned, if the middle of the list is empty, trapping this requires knowing the total row count, If there are cells with values in the remaining cells performing it again, loop this It's not reasonable. and need to find empty cell "" instead of "*". but you cannot enter the value nil or "" as the "what" argument of the excel find function. can't put (strcat (chr 34) (chr 34)) or "\"\"" or :vlax-false also. by vba can find "" but by autolisp cannot. as far as i know Therefore, if you implement this, you have to search for the cell value with "*" and collect more data, so it is inefficient. reverse way changes the search direction. it's the universal way to find the last cell. (setq lastCell (vlax-invoke ColumnD 'Find "*" nil -4163 1 2 2) ; 'Find what after lookin lookat SearchOrder SearchDirection

as he told. try input this to command line (rtos (/ 3652 25.4) 4 4) then apply it to this routine

Consider the rtos function.

Looks like you need a code to look through your code so you can code the local variables into the function description. You have to accept that local and global variables exist, and then when you do it becomes easier, but there needs to be a way to define which is which. For example I'll use a global variable such as "file Location" - and that saves me having lots of LISPs each calculating the file save path when needed, calculate it one, save the variable globally, call the variable as needed instead of "get file location" routine every time - a little more efficient. Global is for that drawing of course, and not every drawing in this sense. Similarly some things such as setting text sizes - set it once, save as a global variable then each text it uses that. Very useful to use Then if you accept global variables as a handy thing to have, you need to consider local variables. Imagine something like this: (if (setq ent (entsel) ) If variable ent has a value then continue. Normally ent starts the LISP as 'nil' and unless you select something this will do not a lot, However if you have used ent previously then it could see that value and carry on, perhaps altering something you didn't just select. As mhupp I much prefer to make my own up and not share them, you don't need to be as precise with stuff like this and little things that creep in you know what it is and can live with it or fix there and then. This might or might not work, it is one of those functions that I wrote for myself "srchlsp" which -should- return a list of all the LISP routines in a file and list the variables in each, then just copy and paste local variables as you want. It might refer to other LISPs not copied here - so let me know where it goes wrong and what errors it sends. This is unchecked by others so what you find will only improve what I have ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Returns lists of setq variables in a LISP ;; Appears to fail if string contains "/" ;; Do a batch type, rename results text page and open them all as checking ;;Command: SrchLsp ;;Limitations: ;;If defun is all on 1 line, the LISP is ignored (vl-load-com) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:srchlsp ( / MyFile) ; ready for batch (setq MyFile (getfiled "Select LISP File to Query" (getmyfolder) "lsp" 16)) (srchlsp MyFile ) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun lstprts ( MyList StartDel EndDel startpos / result acount acounter NewLst pos) ;; Make list from lines (setq NewLst (list)) (setq acounter 0) (setq acount startpos) (while (< acount (length MyList)) (if (= (nth acount MyList) StartDel) (setq acounter (+ acounter 1)) ) (if (= (nth acount MyList) EndDel) (setq acounter (+ acounter -1)) ) (setq acount (+ acount 1)) (if (= acounter 0) (progn (setq pos acount) (setq acount (length MyList)) ) (progn (setq NewLst (append NewLst (list (nth acount MyList)))) ) ) ) ; end while (setq result (list pos (append (list StartDel) NewLst))) result ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun splitlst ( MyList StartDel EndDel / result acount lst aresult x y z) ;; split into main functions (setq result (list)) (setq acount 0) (while (< acount (length MyList)) ; split up main functions (setq lst (lstprts MyList StartDel EndDel acount)) (setq result (append result (list (nth 1 lst)))) (setq acount (nth 0 lst)) ) ; end while (setq MyList (list)) (foreach x result (setq aresult (splitsublist x StartDel EndDel)) (foreach y aresult (setq z (vl-string-left-trim "0123456789 " y)) (setq MyList (append MyList (list z))) ) ) ; end foreach MyList ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun splitsublist ( MyList StartDel EndDel / StartCounter SplitList SplitListLength defcounterlist maxdefcount totaldefuns defuncount acount) ; split sub functions (setq StartCounter 0) (setq SplitList (list)) (setq SplitListLength 0) (setq defcounterlist (list 0)) (setq maxdefcount 0) (setq totaldefuns (- (length MyList) (length (vl-remove StartDel MyList)))) (if ( = totaldefuns 1) (progn (setq MyList (LM:Unique MyList)) ; unique values only (setq SplitList (list (strcat "0 " (LM:lst->str MyList " ") ))) ) (progn (setq defuncount -1) (setq acount 0) (while (< acount totaldefuns) ; create blank list, SplitList (setq SplitList (append SplitList (list (rtos acount) ))) (setq acount (+ acount 1)) ) (foreach x MyList (if (= x StartDel) (progn (setq maxdefcount (+ maxdefcount 1)) (setq defcounterlist (append defcounterlist (list maxdefcount))) ) ; end progn ) ; go up 1 (setq defuncount (- (last defcounterlist) 1) ) (setq SplitList (subst (strcat (nth defuncount SplitList) " " x) (nth defuncount SplitList) SplitList)) (if (= x EndDel)(setq defcounterlist (reverse (cdr (reverse defcounterlist)))) ) ; go down 1 defuncounter ; (if (= x StartDel)(setq defuncount (+ defuncount 1))) ; go up 1 defuncounter ; (setq SplitList (subst (strcat (nth defuncount SplitList) " " x) (nth defuncount SplitList) SplitList)) ; (if (= x EndDel)(setq defuncount (- defuncount 1))) ; go down 1 defuncounter ) ; end foreach (setq asplitlist (list)) (foreach x SplitList (setq SplitList (subst (LM:lst->str (LM:Unique (LM:str->lst x " ")) " ") x SplitList)) ; unique values ) ) ; end prgn ) ; end if SplitList ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) (defun LM:lst->str ( lst del / ) (if (cdr lst) (strcat (car lst) del (LM:lst->str (cdr lst) del)) (car lst) ) ) (defun LM:Unique ( l / ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))) ) (defun LM:StringSubst ( new old str / inc len ) (setq len (strlen new) inc 0 ) (while (setq inc (vl-string-search old str inc)) (setq str (vl-string-subst new old str inc) inc (+ inc len) ) ) str ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun removequotes ( line / splittext acount) (setq splittext (LM:str->lst line (chr 34))) ; ignore " (setq acount 0) (setq line "") (while ( < acount (length splittext)) (setq line (strcat line (nth acount splittext))) (setq acount (+ acount 2)) (if (= acount (length splittext))(setq line (strcat line (last splittext)))) ; a bad fix ) ; end while line ) ; end defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun countbracketO ( line / splittext) (setq line (removequotes line)) (setq splittext (LM:str->lst line (chr 40))) (- (length splittext) 1) ) ; end defun (defun countbracketC ( line / splittext) (setq line (removequotes line)) (setq splittext (LM:str->lst line (chr 41))) (- (length splittext) 1) ) ; end defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun MakeClipBoardText ( MyText / htmlfile ) (vlax-invoke (vlax-get (vlax-get (setq htmlfile (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "Text" Mytext) (vlax-release-object htmlfile) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun WriteListToFile ( AList / fn Lispfile LFDES x MyString) (setq fn "srchlsp.txt") (if (strcat (getvar "TEMPPREFIX") fn)(vl-file-delete (strcat (getvar "TEMPPREFIX") fn))) (setq Lispfile (strcat (getvar "TEMPPREFIX") fn)) (setq LFDES (open Lispfile "w")) (foreach x AList (setq MyString (vl-string-trim "EndDefun" x)) (write-line MyString LFDES) ) (setq LFDES (close LFDES)) (if (findfile Lispfile) (startapp "notepad" Lispfile)) (if (not (findfile Lispfile)) (princ "\nError writing file")) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;returns the next word(s) in a text string after the search term(s) (defun NextWord ( s p / l result lcount pcount MyString x y) (defun xyz123 ( p l lcount / MyString pcount x ) (setq MyString nil) (setq pcount 0) (while (< pcount (length p)) (if (setq x (vl-string-search (strcase (nth pcount p)) (strcase (nth lcount l)))) ; if in text strng, (progn (setq MyString (strcat (nth pcount p) " " (nth (+ lcount 1) l))) (setq pcount (+ pcount 1)) ) (progn (setq pcount (+ pcount 1)) ) ; end progn ) ; end if ) ; end while MyString ) ; end defun ;; (setq s (strcase s)) (setq l (LM:str->lst s " ") ) ; make line into list (setq result (list)) (setq y 0) (setq pcount 0) (while (< pcount (length p) ) ; check line for search terms ;; (setq x (vl-string-search (strcase (nth pcount p)) s)) (setq x (vl-string-search (strcase (nth pcount p)) (strcase s))) (if (= x nil)()(setq y (+ y 1))) (setq pcount (+ pcount 1)) ) ; end while (if (> y 0) ; do for applicable lines (progn (setq lcount 0) (while (< (+ lcount 1) (length l)) (setq MyString (xyz123 p l lcount)) (if (= MyString nil) () (setq result (append result (LM:str->lst MyString " ") )) ) (setq lcount (+ lcount 1)) ) ; end while ) ; end if ) ; end progn result ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun srchlsp ( file / *error* searchlist EndDelim Nesteddefuns TxtLst f CTO CTC CT Line FoundText MyCount TempList LstTxt x) (defun *error* ( msg / MyError ) (setq MyError 1) (if (and file (eq 'FILE (type file))) (close file)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (defun stringsub ( MyString newterm oldterm / ) (setq strsrch (vl-string-search oldterm MyString)) (while (/= strsrch nil) (setq MyString (vl-string-subst newterm oldterm MyString) ) (setq strsrch (vl-string-search oldterm MyString)) ) MyString ) (setq alerttext "This will produce a temporary text file showing:") (setq alerttext (strcat alerttext "\nFunction names variables used in that function.")) (setq alerttext (strcat alerttext "\n\nResults Explained")) (setq alerttext (strcat alerttext "\n'(' Blank line indicates a 1 line function (unnamed in this listing)")) (setq alerttext (strcat alerttext "\nVariables will only be found if coded \"(strcat xyz....\"")) (setq alerttext (strcat alerttext "\nThe whole lot failes if brackets are out of order or other similar things")) (alert alerttext) (setq searchlist (list (strcat "(defun")(strcat "(setq")(strcat "(foreach") )) (setq enddelim "EndDefun") (setq nesteddefuns (list)) (setq TxtLst (list) ) (setq ctO 0)(setq ctC 0)(setq ct 0) ;; reset bracket counters (setq linelist (list)) (princ "Searching for: ")(princ searchlist)(princ "\n") (if (setq f (open file "r")) (progn (while (setq line (read-line f)) (setq line (stringsub line "" (strcat (chr 92)(chr 92)))) ; remove \\ (setq line (stringsub line "" (strcat (chr 92)(chr 34)))) ; remove \" (setq line (removequotes line)) ;; remove quotes '"' (setq line (nth 0 (LM:str->lst line ";"))) ;; Remove Comments ';' (if (or (= line nil) (= line "") ) ;; ignore commented out lines, blank lines () (progn (setq ctO (countbracketO line)) ;; count opening brackets (setq ctC (countbracketC line)) ;; count closing brackets (setq ct (+ ct (- ctO ctC))) ;; sum brackets (if (= (wcmatch (strcase line) (strcase (strcat "*" (nth 0 searchlist) "*"))) nil) ;;assuming only 1 defun per line () (if (= ctO ctC) (setq nesteddefuns (append (list ct) nesteddefuns)) ; single line function (if (= ctC 0) (progn (while (/= ctO (+ ctC 1)) (setq lineb (read-line f)) (setq lineb (LM:StringSubst "" (strcat (chr 92)(chr 34)) lineb)) (setq lineb (removequotes lineb)) ;; remove quotes '"' (setq lineb (nth 0 (LM:str->lst lineb ";"))) ;; Remove Comments ';' (if (or (= lineb nil) (= lineb "") ) ;; ignore commented out lines, blank lines () (progn (setq line (strcat line lineb)) (setq ctO (countbracketO line)) ;; count opening brackets (setq ctC (countbracketC line)) ;; count closing brackets (setq ct (+ ct (- ctO ctC))) ;; sum brackets ) ; end progn ) ; end if ) ; end while (setq nesteddefuns (append (list (- ct 1)) nesteddefuns)) ; multiline function ) ; end progn (progn (setq nesteddefuns (append (list (- ct 1)) nesteddefuns)) ; multiline function ) ; end progn ) ; end if ) ; end if ) ; end if (if (= ct (car nesteddefuns)) ;; if ct value is the same as the list (progn (setq linelist (append linelist (list enddelim))) (setq nesteddefuns (cdr nesteddefuns)) ) ; end progn ) ; end if ;;;add in search expressions (if (and (foreach x seachlist (= (wcmatch (strcase line) (strcase (strcat "*" x "*"))) nil) ) ) () (setq linelist (append linelist (NextWord line searchlist))) ;;; (setq linelist (append linelist (NextWord (vl-string-trim " " line) searchlist))) ) ; end if ) ; end progn ) ; end if 'non blank lines' ) ; end while (close f) ) ; end progn ) ; end if (setq lsttxt (splitlst linelist (nth 0 searchlist) enddelim)) ;Display in command line (foreach x lsttxt (princ "\n") (princ (type x)) (princ x) ) (WriteListToFile lsttxt) ;; (MakeClipBoardText (LM:lst->str lsttxt " ")) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

"rectabgle" a new Autocad object

This is what I use. It requires that your new blocks location is added to the search path so they can be found. The old blocks that have the same name will be redefined. (defun c:foo (/ file out) (vlax-for x (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (if (not (wcmatch (strcase (vla-get-name x)) "*|*")) (setq out (cons (vla-get-name x) out)) ) ) (setvar 'cmdecho 0) (foreach x out (if (setq file (findfile (strcat x ".dwg"))) (progn (command ".-INSERT" (strcat x "=" file) nil) (and (ssget "_x" (list '(0 . "insert") (cons 2 x) '(66 . 1))) (command "._attsync" "name" x) ) ) ) ) (setvar 'cmdecho 1) (princ) )

So you could use ssget (see http://lee-mac.com/ssget.html ) to select block 1: This will select all blocks. (setq ss (ssget "_X" ' ((0. "INSERT") (2. "Block Name"))) ) Then loop through the selection set with a while, repeat foreach or however loop Using the selected block you can get it's insert point: (setq MyBlock (ssname ss count)) ; where count is the item number in the selection set (set pt (cdr (assoc 10 (entget Myblock)))) ; gets the insertion point of the block And then back to selection set, select all block 2 that lie within an area of this insertion point: (setq pt1 (mapcar '+ (-5 -5 0) pt)) ; 4 corners of a rectabgle round the block (setq pt2 (mapcar '+ (-5 +5 0) pt)) (setq pt3 (mapcar '+ (+5 +5 0) pt)) (setq pt4 (mapcar '+ (+5 -5 0) pt)) (setq ss2 (ssget "_CP" (list pt1 pt2 pt3 pt4) '((2 . "Block Name 2")) )) and work out if ss2 is nil or a list - if it is a list then count it. Might work (CAD is off for today so the above is untested but might point you near to what you want) As Dan above, post your LISP if you can and it might be a simple change in that to make it work - keeping the work you did

give me a explain, what's the difference between this 2 steps and the comment above.

1. Create a dwg file containing new blocks. 2. Select blocks to be modified using QSELECT or layer filter in the drawing to be modified. 3. Copy with CopyBase (Ctrl+Shift+C) 0,0 4. ERASE and PURGE for Delete Blocks. 5. Insert the DWG file containing the new block into the drawing using XREF. 6. in XREF window INSERT(not BIND) that for merging this will make the new blocks into the original drawing. 7. Paste the CopyBase block from the clipboard with Ctrl+V 0,0 Since the copybased inform contains only the block name, it is pasted as a new block. 8. Delete the inserted XREF. or try this routine ; REPLACEBLOCKS - 2023.09.04 exceed ; Replace existing blocks with duplicate names with copied blocks. (defun c:REPLACEBLOCKS (/ *error* answer ss thisdrawing mspace entl myline ent ssl index bnamelist entp objp objtype bname bnlen recoverlist bnold bntemp rcl 1blk fromname toname ssb n e1 edata ) (vl-load-com) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (vla-EndUndoMark thisdrawing) (princ) ) (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (setq mspace (vla-get-modelspace thisdrawing)) (vla-startundomark thisdrawing) (princ "\n Replace existing blocks with duplicate names with copied blocks.") (princ "\n you need to copy the block from another drawing and then run this command.") (setq answer (getstring "\n If you already copied, press the space bar / If not, press ESC.")) (setq ss (ssadd)) (if (setq entl (entlast)) (progn) (progn (setq myline (vla-addline mspace (vlax-3d-point (list 0 0 0))(vlax-3d-point (list 1 1 1)))) (setq entl (entlast)) (ssadd entl ss) ) ) (setvar 'cmdecho 0) (command "pasteclip" "0,0") (while (setq ent (entnext entl)) (ssadd ent ss) (setq entl ent) ) (setq ssl (sslength ss)) (setq index 0) (setq bnamelist '()) (repeat ssl (setq entp (ssname ss index)) (setq objp (vlax-ename->vla-object entp)) (setq objtype (vlax-get-property objp 'EntityName)) ;(princ objtype) (if (= objtype "AcDbBlockReference") (progn (setq bname (vlax-get-property objp 'effectivename)) (setq bnamelist (cons bname bnamelist)) ) ) (setq index (+ index 1)) ) (setq bnamelist (vl-sort bnamelist '<)) ;(princ bnamelist) (repeat ssl (setq entp (ssname ss 0)) (entdel entp) (ssdel entp ss) ) ;; Unique - Lee Mac ;; Returns a list with duplicate elements removed. (defun LM:Unique ( l ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))) ) (setq bnamelist (LM:Unique bnamelist)) ;(princ bnamelist) (setq bnlen (length bnamelist)) (setq recoverlist '()) (repeat bnlen (setq bnold (car bnamelist)) (setq index 0) (setq bntemp (strcat bnold "-TEMP")) (while (tblsearch "BLOCK" bntemp) (setq bntemp (strcat bnold "-TEMP" (vl-princ-to-string index))) (setq index (+ index 1)) ) (vla-put-Name (vla-item (vla-get-blocks thisdrawing) bnold) bntemp) (setq recoverlist (cons (list bntemp bnold) recoverlist)) (setq bnamelist (cdr bnamelist)) ) (vla-PurgeAll thisdrawing) (setq ss (ssadd)) (setq entl (entlast)) (if (= entl nil) (progn (setq myline (vla-addline mspace (vlax-3d-point (list 0 0 0))(vlax-3d-point (list 1 1 1)))) (setq entl (entlast)) (ssadd entl ss) ) ) (command "pasteclip" "0,0") (while (setq ent (entnext entl)) (ssadd ent ss) (setq entl ent) ) (repeat ssl (setq entp (ssname ss 0)) (entdel entp) (ssdel entp ss) ) (setq rcl (length recoverlist)) (setq index 0) (repeat rcl (setq 1blk (nth index recoverlist)) (setq fromname (car 1blk)) (setq toname (cadr 1blk)) (if (setq ssb (ssget "_X" (list (cons 2 fromname)))) (repeat (setq n (sslength ssb)) (setq e1 (ssname ssb (setq n (1- n)))) (setq edata (entget e1)) (entmod (subst (cons 2 toname) (cons 2 fromname) edata)) (entupd e1) ) ) (setq index (+ index 1)) ) (command "redraw") (vla-PurgeAll thisdrawing) (setvar 'cmdecho 1) (vla-EndUndoMark thisdrawing) (princ) ) This is a rough routine, so it's not elegant. It's just an idea, so someone better can edit it. how to use it 1. Copy new blocks to copy base. 2. Run REPLACEBLOCKS on the drawing to be replaced. How it Works 1. Paste the copybased items once and add them to the selection set. 2. Since entlast is used to insert into the selection set, a temporary line is created in case entlast does not exist. (although it is almost never necessary...) 3. Collect block names by cycling through the selection set. 4. Filter out unique names. 5. Delete temporarily pasted objects and lines. 6. Find the corresponding block name in the blocks of this drawing. 7. Change the name to one with -TEMP. In case of duplicates, add serial numbers after that -TEMP. 8. Create a list by pairing the original name and TEMP name. To return it to its original state later. 9. Delete the existing block definition with PurgeAll. 10. PasteSpec again and paste the block from the clipboard to create a new definition. and then delete them. 11. Revert to the name changed with entmod. 12. Run purgeall again to delete the TEMP block definition. 13. End Since the temporary block is pasted twice and the temporary line is also created and deleted, it is best to check the area near 0,0 once. It worked fine in my tests, but I didn't assume all the scenarios.

@Hsanon if you don't have attributes so you don't need attsync.

Like aridzv 1. Insert a new block to 0,0 2. apply attsync (command "attsync" "S" (entlast)) 3 (command "Erase" (entlast) "") you dont need to keep the block that has been inserted. 4 Repeat for all blocks