Author Topic: I think I found this code here..? Can this be modified to include nested blocks?  (Read 7580 times)

0 Members and 1 Guest are viewing this topic.

DHOPP

  • Guest
I love how this works, would love for it to swap out nested blocks

Code: [Select]
; 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)

T.Willey

  • Needs a day job
  • Posts: 5251
If you want this to do all blocks, then you should just step through the block table to get the names.  This way, shown below, will do that, plus it will remove xref, xref dependent, and anonymous blocks from the list.  Just add ' BlkData ' and ' tempNum ' to the local variable list.

Code: [Select]
(while (setq BlkData (tblnext "block" (not BlkData)))
    (if
        (and
            (setq tempNum (cdr (assoc 70 BlkData)))
            (not (equal (logand 32 tempNum) 32))
            (not (equal (logand 1 tempNum) 1))
        )
        (setq blklst (cons (cdr (assoc 2 BlkData)) blklst))
    )
)
(if (not blks)
  (progn
(alert "There are NO Blocks to redefine.")
(*error*)
   )
)

This code will replace this section

Code: [Select]
; 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
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

DHOPP

  • Guest
Thanks so much for your help T.Willey, works perfectly!

I made one minor change

Code: [Select]
(while (setq BlkData (tblnext "block" (not BlkData)))
    (if
        (and
            (setq tempNum (cdr (assoc 70 BlkData)))
            (not (equal (logand 32 tempNum) 32))
            (not (equal (logand 1 tempNum) 1))
        )
        (setq blklst (cons (cdr (assoc 2 BlkData)) blklst))
    )
)
(if (not blks)[color=red]<-----changed to (if (not blklst)[/color] 
(progn
(alert "There are NO Blocks to redefine.")
(*error*)
   )
)

T.Willey

  • Needs a day job
  • Posts: 5251
You're welcome.  Good catch on that.  I thought that was the variable in the code, when I found I was wrong, I went back and changed it.  Thought I got them all.   :-D
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

DHOPP

  • Guest
I am still learning, basic stuff I am ok at, with this sort of routine I like to open the help menu and comment the code...thanks again

T.Willey

  • Needs a day job
  • Posts: 5251
I am still learning, basic stuff I am ok at, with this sort of routine I like to open the help menu and comment the code...thanks again

You're welcome, and good for you to take the initiative to learn.  If you have questions on the part I wrote, let me/us know, and we can explain it.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Kinda off topic but you may wish to revisit the calls to the *error* function.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

DHOPP

  • Guest
Kinda off topic but you may wish to revisit the calls to the *error* function.

Care to explain please?  

My *error* functions typically (I did not write this program) reset vars and set undo marks only, It appears to me that his *error* function only stops the process bar from running, and letting the user know "there are no blocks....."

I will wait to find out what you meant

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Traditionally error functions are declared to take one argument (a string summarizing the error), and thus the calls to same require that argument. Calling a function that requires an argument without providing said argument will generate an error, which while somewhat amusing in this context, is a programming error, not an execution error. I see calls to the error function in this thread like this (*error*), prompting my intrusion.

:)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

wizman

  • Bull Frog
  • Posts: 290
Quote
Traditionally error functions are declared to take one argument (a string summarizing the error), and thus the calls to same require that argument. Calling a function that requires an argument without providing said argument will generate an error, which while somewhat amusing in this context, is a programming error, not an execution error. I see calls to the error function in this thread like this (*error*), prompting my intrusion.


interesting catch..:-)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Thanks wizman. :)

*crickets*
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

DHOPP

  • Guest
Traditionally error functions are declared to take one argument (a string summarizing the error), and thus the calls to same require that argument. Calling a function that requires an argument without providing said argument will generate an error, which while somewhat amusing in this context, is a programming error, not an execution error. I see calls to the error function in this thread like this (*error*), prompting my intrusion.

:)

Thanks, no problem intruding, like I said to T. Willey, I like to grab code, go to the help menu and comment it, replies from people with experience I count as help too.  I make time to learn, baby steps, I'll get it.