Help with LISP/VB to pull blocks out of drawings.

[dmallette]

I'm in a bad situation where the previous cad person in the office where I now work decided that when he left on bad terms he would take all sections/details and basically anything that would help the next cad person at all when he left the company.

 

I am looking for any way to pull any/all blocks out of the few drawings that were left on backups and servers so I can attempt to recover some of what was previously here without having to go file by file and pull out and resave each and every one of the sections and details just to help rebuild even a portion of what was once here.

 

Thanks in advance for any and all help you can offer!!!

 

Dewey Mallette

[CmdrDuh]

that can be done. Have you looked in a few old dwgs and seen that blocks exist or were they inserted and exploded

[dmallette]

Some have been exploded. But there are drawings that have them not exploded and intact.

 

Thanks in advance.

 

DM

[CmdrDuh]

Let me see what I can work up

[Lee Mac]

I was thinking something of the form:

 

[b]; BlockSave, created by Lee McDonnell December 2008


(defun c:bs () (c:blocksave)) ; Program Shortcut

(defun GetLayerList ()
   (vl-load-com)
   (vlax-for l 
       (vla-get-Layers
              (vla-get-ActiveDocument
           (vlax-get-acad-object)))
       (setq oLst
           (cons(vla-get-Name l)oLst)
       ) ; end setq
   ); end vlax-for
     (reverse oLst)
); end of GetLayerList

(defun c:blocksave (/ ss ssl xth ent)
   (setvar "cmdecho" 0)
   (GetLayerList)
   (foreach n oLst
       (if (setq ss (ssget "X" (list (cons 0 "INSERT")(cons 410 (getvar "ctab"))(cons 8 n))))
           (progn
               (setq     ssl (sslength ss)
                         xth 0
               ) ; end setq
               (repeat ssl
                   (setq ent (ssname ss xth))
                   (command "wblock" ent.... ; not sure how to write this bit  
                   (setq xth (+ xth 1))
               ) ; end repeat
           ) ; end progn
           (princ (strcat "\nNo Blocks on Layer: " n))
       ) ; end if
   ) ; end foreach
   (setvar "cmdecho" 1)
   (prompt "\nFunction Complete.")
   (princ)
) ; end program
[/b]

But I can't work out how to code the "wblock" line. - if this helps in any way...

[dmallette]

How do you run those?

I'm not familiar with VBA or LISP at all.

 

Thanks!!!

DM

[Lee Mac]

To run a LISP file:

1. Copy the posted code into a new Notepad document.
   
2. Save the document - make sure you change the ".txt" to ".lsp" and change the drop-down box to "all files" instead of "text documents"
   
3. Open ACAD
   
4. type "_appload" in the command line or click tools, load application
   
5. select the saved file
   
6. click load
   
7. type the syntax specified in the LISP code into the command prompt. ~ in my LISP: "bs" or "blocksave".
   
8. LISP will run
   
9. As a side note - you can click on Startup Suite within the Load Application dialogue box and add the LISP to the Suite to make it load every time ACAD is loaded.

Obviously my LISP will not load or run as it is missing a line of coding - as marked on the code.

 

But will some input from others, I'm sure we can find a solution.

[Lee Mac]

Found this LISP on the internet (untested):

 

;;;==WBLKALL.LSP=====================================================
;;;  (C) 1993, Chris Bryant (CIS 72570,1012)
;;;
;;;  This program WBLOCKs all block definitions in a drawing.
;;;  Features include:
;;;
;;;  1.  Writes the block to the current directory.
;;;
;;;  2.  Prompts user for new name if the block name is
;;;      more than 8 characters long.
;;;
;;;  3.  If a .DWG file with the same name already exists,
;;;      WBLKALL will ask permission first before overwriting.
;;;
;;;==================================================================

(prompt "\nWBLKALL.LSP - (C) 1993, Chris Bryant\nLoading ...")

;---------------------------------------------------------------------

(defun C:WBLKALL (/ EXPR CNT BLK_NAME BLK_LIST WBLOK WBLK L YN)
 (setq EXPR (getvar "expert"))
 (setvar "EXPERT" 4)
 (setq CNT 0)
 (setq BLK_NAME (cdr (assoc 2 (tblnext "BLOCK" T)))
       BLK_LIST (list BLK_NAME))
 (prompt "\nBuilding block list ...")
 (while (/= BLK_NAME nil)
   (setq BLK_NAME (cdr (assoc 2 (tblnext "BLOCK"))))
   (if (/= BLK_NAME nil)
     (setq BLK_LIST (cons BLK_NAME BLK_LIST))
   )
 )
 (prompt "\nWriting blocks .")
 (while (/= BLK_LIST nil)
   (setq WBLOK (car BLK_LIST)
         BLK_LIST (cdr BLK_LIST)
   )
   (if (/= (substr WBLOK 1 1) "*")
     (progn
       (setq CNT (1+ CNT))
       (princ ".")
       (if (> (strlen WBLOK) 
         (progn
           (setq WBLK WBLOK)
           (prompt (strcat "\nBlock name " WBLOK " is too long!"))
           (setq L T)
           (while (= L T)
             (setq WBLK (getstring
                        "\nEnter new block name, 8 characters or less: "
                        ))
             (if (or (> (strlen WBLK)  (= WBLK ""))
                   (prompt "\nInvalid response.")
                   (setq L nil)
             )
           )
           (if (/= BLK_LIST nil) (prompt "\nWriting blocks ."))
         )
         (setq WBLK WBLOK)
       )
       (if (equal (open (strcat WBLK ".DWG") "r") nil)
           (command "wblock" WBLK WBLOK)
           (progn
             (initget 1 "Yes No")
             (setq YN (getkword
                         (strcat
                           "\nFile " WBLK ".DWG exists. Replace? <Y/N> "
                         )))
             (if (equal YN "Y") (command "wblock" WBLK WBLOK))
             (prompt "\nWriting blocks .")
           )
       )
     )
   )
 )
 (setvar "EXPERT" EXPR)
 (prompt "\n ")
 (prompt "\nWBlocking complete.")
 (princ)
)
;----------------
(prompt " done.")
(princ)

 

May help.

[Lee Mac]

Haha - and my attempt:

 

Criticism very welcome - lots of assumptions made within the code - not best pleased with this - but it does the job

 

; BlockSave, created by Lee McDonnell December 2008


(defun c:bs () (c:blocksave)) ; Program Shortcut

(defun GetLayerList ()
   (vl-load-com)
   (vlax-for l 
       (vla-get-Layers
              (vla-get-ActiveDocument
           (vlax-get-acad-object)))
       (setq oLst
           (cons(vla-get-Name l)oLst)
       ) ; end setq
   ); end vlax-for
     (reverse oLst)
); end of GetLayerList

(defun c:blocksave (/ lay ss ssl xth bnum ent bname)
   (setvar "cmdecho" 0)
   (GetLayerList)
   (setq lay 0)
   (foreach n oLst
       (if (setq ss (ssget "X" (list (cons 0 "INSERT")(cons 410 (getvar "ctab"))(cons 8 n))))
           (progn
               (setq     ssl (sslength ss)
                   xth 0
                   bnum 0
               ) ; end setq
               (repeat ssl
                   (setq ent (ssname ss xth))
                   (setq bname (strcat "blk" (itoa lay) (itoa bnum)))
                   (command "wblock" bname "" "0,0" ent "")
                   (setq xth (+ xth 1))
                   (setq bnum (+ bnum 1))
               ) ; end repeat
           ) ; end progn
           (princ (strcat "\nNo Blocks on Layer: " n))
       ) ; end if
   (setq lay (+ lay 1))
   ) ; end foreach
   (setvar "cmdecho" 1)
   (prompt "\nFunction Complete.")
   (princ)
) ; end program

 

Let me start

 

Possible Problems:

 

• if there are files on computer with names like blk01 or blk13 - these may be overwritten.
  
• Not sure where the files will be saved.
  
• Basepoint is always the origin.

There are probably tons more points to be raised...

[dmallette]

Thank you very much!

 

It's working. Unfortunately it seems he exploded more

of the blocks than I originally thought.

 

It's not pulling many blocks out of the files.

 

Out of 50+ files I've managed to pull about 7 blocks out.

and most of those were titles and other information that

isn't going to help.

 

If anyone has any sections/details they might could send

my way I'd greatly appreciate it!!

 

 

Thank you though!

 

DM

[CmdrDuh]

well Lee beat me to it, but after reading where you are now, I would suggest batch printing all your drawings to 11x17 or something similiar (think cheap paper) and create a paper library of all your details. Then as time permits, you could wblock out of each drawing and make your details. I have code that will assist in that if you want it. I have a friend that had the exact same problem you have and he used it to make a complete library.

[Lee Mac]

Unfortunately it seems he exploded more

of the blocks than I originally thought.

 

Unfortunately it seems people can be such a**holes sometimes.

[dmallette]

Lee Mac - Thank you for that code again.

 

CmdrDuh - Thank you. I'd greatly appreciate the code and the info on how you and your friend fixed all of that and got all of their blocks back.

 

 

DM

[CmdrDuh]

Imagine a detail page with 12-16 details on it, all exploded. I wrote a command that allows you to window an area, and it wblocks out the work to a file you name. I think I had it autonumber the files also, i will have to look.

[CmdrDuh]

When you run the function, you add the detail number in the text box, use the buttons to create fhe files. It Adds DTL to the beginning of the number, and writes out to a folder c:\details\. All of which is customizable to fit your situation.

[CmdrDuh]

here is the file

Wblock.zip

[dmallette]

Thanks CMDRDUH I got it to work PERFECTLY to pull the blocks that were messed up out!