Wblock lisp to save to a autocad default

[BrianTFC]

Lee Mac wrote this awesome lisp routine to be able to select multiple objects and wblock block them out as separate drawings, which works great. My problem i'm having is the program that i'm using for my router was written in 2010 and won't except the 2013 file's and for some reason wblock won't except the autocad default when i run the lisp routine, it saves them to 2013. I was wondering if someone could help me with this i would really appreciate it.

 

Thanks again,

Brian

 

;; WBlock Rectangles  -  Lee Mac
;; For improved performance, disable DWG thumbnail generation
(defun c:wbr ( / app blk cpy dir doc dwg err in1 in2 llp lst mid obj org sel ssc sso tmp urp ) 
(setvar 'cmdecho 0)
  
   (if (setq sel (ssget "_:L" '((0 . "LWPOLYLINE"))))
       (progn
           (setq app (vlax-get-acad-object)
                 doc (vla-get-activedocument app)
                 ssc (vla-get-selectionsets  doc)
                 sso (vl-catch-all-apply 'vla-item (list ssc "wbr-sel"))
                 org (vlax-3D-point 0 0)
                 dir (getvar 'dwgprefix)
           )
           (if (vl-catch-all-error-p sso)
               (setq sso (vla-add ssc "wbr-sel"))
           )
           (vla-zoomextents app)
           (repeat (setq in1 (sslength sel))
               (setq obj (vlax-ename->vla-object (ssname sel (setq in1 (1- in1)))))
               (vla-getboundingbox obj 'llp 'urp)
               (setq llp (vlax-safearray->list llp)
                     urp (vlax-safearray->list urp)
                     mid (vlax-3D-point (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) llp urp))
               )
               (vla-clear sso)
               (if (setq tmp (ssget "_C" (trans urp 0 1) (trans llp 0 1)))
                   (progn
                       (repeat (setq in2 (sslength tmp))
                           (setq cpy (vla-copy (vlax-ename->vla-object (ssname tmp (setq in2 (1- in2)))))
                                 lst (cons cpy lst)
                           )
                           (vla-move cpy mid org)
                           (if (= "AcDbText" (vla-get-objectname cpy))
                               (setq blk (vla-get-textstring cpy))
                           )
                       )
                       (cond
                           (   (null blk))
                           (   (not (snvalid blk))
                               (princ (strcat "\nInvalid block name \"" blk "\"."))
                           )
                           (   (findfile (setq dwg (strcat dir blk ".dwg")))
                               (princ (strcat "\n" dwg " already exists."))
                           )
                           (   (progn
                                   (vlax-invoke sso 'additems lst)
                                   (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vla-wblock (list doc dwg sso))))
                               )
                               (princ
                                   (strcat
                                       "\nError creating drawing: " dwg
                                       "\nDetail: " (vl-catch-all-error-message err)
                                   )
                               )
                           )
                       )
                       (foreach obj lst (vla-delete obj))
                       (setq lst nil
                             blk nil
                       )
                   )
               )
           )
           (vla-zoomprevious app)
           (vla-delete sso)
       )
(setvar 'cmdecho 1)
   )
   (princ)
)
(vl-load-com) (princ)

[Lee Mac]

Try this modified version Brian:

(defun c:wbr ( / app blk cmd dir dwg in1 in2 llp mid obj sel tmp urp ) 
   (if (setq sel (ssget "_:L" '((0 . "LWPOLYLINE"))))
       (progn
           (setq app (vlax-get-acad-object)
                 dir (getvar 'dwgprefix)
                 cmd (getvar 'cmdecho)
           )
           (setvar 'cmdecho 0)
           (vla-zoomextents app)
           (repeat (setq in1 (sslength sel))
               (setq obj (vlax-ename->vla-object (ssname sel (setq in1 (1- in1)))))
               (vla-getboundingbox obj 'llp 'urp)
               (setq llp (vlax-safearray->list llp)
                     urp (vlax-safearray->list urp)
                     mid (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) llp urp)
               )
               (if (setq tmp (ssget "_C" (trans urp 0 1) (trans llp 0 1)))
                   (progn
                       (repeat (setq in2 (sslength tmp))
                           (setq obj (vlax-ename->vla-object (ssname tmp (setq in2 (1- in2)))))
                           (vlax-invoke obj 'copy)
                           (vlax-invoke obj 'move mid '(0.0 0.0 0.0))
                           (if (= "AcDbText" (vla-get-objectname obj))
                               (setq blk (vla-get-textstring obj))
                           )
                       )
                       (cond
                           (   (null blk))
                           (   (not (snvalid blk))
                               (princ (strcat "\nInvalid block name \"" blk "\"."))
                           )
                           (   (findfile (setq dwg (strcat dir blk ".dwg")))
                               (princ (strcat "\n" dwg " already exists."))
                           )
                           (   (vl-cmdf "_.-wblock" dwg "" "_non" '(0.0 0.0) tmp ""))
                       )
                       (setq blk nil)
                   )
               )
           )
           (vla-zoomprevious app)
           (setvar 'cmdecho cmd)
       )
   )
   (princ)
)
(vl-load-com) (princ)

[BrianTFC]

Lee,

 

First off i would like to thank you for all of the help you have given me, and second it work perfectly.

 

Thanks so much Lee,

Brian

[Lee Mac]

Excellent, you're welcome Brian