I love how this works, would love for it to swap out nested blocks
; Created September 2008, by Jim Sowinski
; This will search the entire drawing for all blocks and redefine them.
; However, if a block has been archived or deleted from the active library it will report those blocks
; at the end of the routine. It will ask you if you want to create a spreadsheet with this list.
; If you select "OK" a file will be created and located in the current drawings directory.
;----------------------------------------------------------
; IF "OK" IS PICKED AT THE END OF THE ROUTINE THIS FUNCTION WILL WRITE ALL BLOCK NAMES
; THAT DID NOT GET REDEFINED TO A SPREADSHEET.
(defun spreadsheet (/ createfile username createdby todays_date acl)
(setq xlApp (vlax-get-or-create-object "Excel.Application")
xlBooks (vlax-get-property xlApp "Workbooks")
xlBook (vlax-invoke-method xlBooks "Add")
xlSheets (vlax-get-property xlBook "Sheets")
xlSheet (vlax-get-property xlSheets "Item" 1)
xlCells (vlax-get-property xlSheet "Cells")
)
; HEADERS
(setq createfile (strcat (getvar "dwgprefix") "Blocks NOT Redefined"))
(setq username (getvar "loginname"))
(setq createdby (strcat "Created by " username))
(setq todays_date (menucmd "M=$(edtime, $(getvar,date),MO/DD/YYYY)")) ;ex. 10/09/2007
(vlax-put-property xlCells "Item" 1 1 todays_date)
(vlax-put-property xlCells "Item" 3 1 "This is a list of Blocks that were NOT redined.")
(vlax-put-property xlCells "Item" 4 1 (strcat (getvar "dwgprefix")(getvar "dwgname")))
(vlax-put-property xlCells "Item" 5 1 createdby)
(vlax-put-property xlCells "Item" 7 1 "BLOCKS")
(setq row 8)
(foreach not_found blklst
(if (not (member not_found comparelist))
(progn
(vlax-put-property xlCells "Item" row 1 not_found)
(setq row (1+ row))
)
)
)
; MAKE THE COLUMN WIDTH 25.
(setq acl (vlax-get-property xlsheet 'Range "A1,A7"))
(vlax-put-property acl 'ColumnWidth 25)
; SET THE CELL A7 TO BOLD.
(setq acl (vlax-get-property xlsheet 'Range "A7"))
(vlax-put-property (vlax-get-property acl 'Font) 'Bold :vlax-true)
; SAVEAS TO THE CURRENT DRAWING LOCATION.
(vlax-invoke-method xlsheet "SaveAs" createfile)
; MAKE THE SPREADSHEET VISIBLE.
(vla-put-visible xlApp :vlax-true)
; RELEASE EXCEL VARIABLES
(mapcar (function (lambda(x)
(vl-catch-all-apply
(function (lambda()
(progn
(vlax-release-object x)
(setq x nil)))))))
(list xlCells xlSheet xlSheets xlBook xlBooks xlApp)
)
(gc)(gc)
(setq comparelist nil)
(princ)
); END DEFUN
;--------------------------------
; FIND ALL OF THE DRAWINGS IN THE DIRECTORY PROVIDED BY (GetDrawings "G:/Library Path 1/...")
; THIS WILL ALSO LOOK THROUGH EVERY SUBDIRECTORY.
(defun GetDrawings (path / root_path each_path)
(if dwgnames
nil
(setq dwgnames (append dwgnames (mapcar '(lambda (z)(strcat path z))(vl-directory-files path "*.dwg" 1)) ))
)
(acet-ui-progress "Searching Library....." (length root_path))
(if (setq root_path (vl-directory-files path nil -1))
(apply 'append
(mapcar
(function
(lambda (x)
(cons (setq each_path (strcat path x "/"))(GetDrawings each_path))
(setq dwgnames (append dwgnames (mapcar '(lambda (z)(acet-ui-progress -1)(strcat each_path z))(vl-directory-files each_path "*.dwg" 1)) ))
)
)
(vl-remove "." (vl-remove ".." root_path))
); mapcar
); apply
); end if
); END DEFUN
;--------------------------------
; THIS IS THE SECOND PART TO THE ROUTINE ABOVE. IT WILL CREATE A LIST WITH JUST THE DRAWING NAMES THAT MATCH
; THE NAMES IN THE LIBRARY. THIS WILL BE USED TO GENERATE A LIST OF BLOCK NAMES OF THOSE BLOCKS THAT WERE NOT REDEFINED.
; THEN IT WILL INSERT AND REDEFINE THE BLOCKS THAT MATCH IN THE LIBRARY.
(defun redefine_blks ()
(acet-ui-progress "Redefining Blocks....." (length blklst)) ; START PROCESS BAR
(foreach blk blklst
(if (or
(setq dwgpath (vl-member-if '(lambda (x) (vl-string-search (strcat blk ".dwg") x)) dwgnames))
(setq dwgpath (vl-member-if '(lambda (x) (vl-string-search (strcat blk ".DWG") x)) dwgnames))
)
(progn
(setq comparelist (append comparelist (list blk))) ;CREATE A COMPARISON LIST
(command "insert" (strcat blk "=" (car dwgpath)) (command)) ;INSERT AND REDEFINE BLOCKS.
)
)
(acet-ui-progress -1) ;ADVANCE THE PROCESS BAR
)
); END DEFUN
;=======================================================================
; START ROUTINE
;=======================================================================
(defun c:reblocks (/ sset num blks blklst blklst drawings librarylist archiveblk textline yes fname
openfile)
(setq echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(defun *error* (s)
(acet-ui-progress) ; END PROCESS BAR
(setvar "cmdecho" echo)
(princ)
)
(vl-load-com)
; CREATE A SELECTION SET OF ALL BLOCKS.
(setq sset (ssget "x" '((0 . "INSERT"))))
; IF SSET IS NIL, EXIT
(if sset
nil
(progn
(alert "There are NO Blocks to redefine.")
(*error*)
)
)
; PROCESS THE SELECTION SET TO CREATE A LIST OF BLOCKS TO COMPARE AGAINST THE LIBRARY.
; IF THE SAME BLOCK IS PLACED MANY TIMES IN A DRAWING THIS LIST WILL ONLY STORE THE NAME OF THE FIRST ONE IT FINDS.
; REASON BEING IS THAT YOU ONLY NEED TO REDEFINE THE BLOCK ONCE FOR ALL BLOCKS WITH THE SAME NAME.
(if sset
(progn
(setq num 0)
(repeat (sslength sset)
(setq blks (cdr(assoc 2 (entget (ssname sset num)))))
(if (not (member blks blklst))
(setq blklst (append blklst (list blks)))
)
(setq num (1+ num))
); end repeat
(setq blklst (vl-sort blklst '<))
); end progn
); end if
;--------------------------------
; DIRECTORIES TO SEARCH FOR DRAWINGS.
; EDIT THESE TO THE PATH OF YOUR DRAWING LIBRARY(S).
; YOU CAN HAVE MORE THAN ONE PATH, (AS SHOWN BELOW) OR REMOVE ONE LINE FOR A SINGLE LIBRARY PATH.
; JUST MAKE SURE THAT (redefine_blks) FOLLOWS THE LAST SEARCH PATH.
(GetDrawings "W:/Blocks/")
;;;(GetDrawings "G:/Library Path 2/")
(redefine_blks)
(acet-ui-progress) ; END PROCESS BAR
(setq dwgnames nil)
;--------------------------------
; CREATE A LIST OF ALL BLOCKS THAT DID NOT GET REDEFINED.
(foreach not_found blklst
(if (not (member not_found comparelist))
(setq archiveblk (append archiveblk (list not_found "\n")))
)
)
;--------------------------------
; FINISH WITH ALERT BOX. CREATE A SPREADSHEET IF "OK" IS SELECTED.
(if archiveblk
(progn
(setq textline (strcat "These blocks were not redefined. \nThey might be archived.\n \n" (apply 'strcat archiveblk) "\nIf you want to create a spreadsheet with this list pick \"OK\". Otherwise cancel."))
(setq yes (acet-ui-message textline "Blocks NOT Redefined" 1))
(if (= yes 1)
(spreadsheet)
)
);end progn
(alert "ALL of the blocks have been redefined.")
)
;--------------------------------
(setq comparelist nil)
(setvar "cmdecho" echo)
(princ)
); END DEFUN
(princ)