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

;;; MWBLOCK.LSP (Multiple WBlock)

;;; English translated

;;;

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

;;;

(defun DXF (C E / )(cdr (assoc C E)))

;;;

;;;

;;;

(defun BLOCK_LIST ( / DBL LBL)

(while

(setq DBL (tblnext "BLOCK" (not DBL)))

(if

(/= "*" (substr (DXF 2 DBL) 1 1))

(setq LBL

(append LBL (list (DXF 2 DBL)))

)

)

)

(if LBL

(setq LBL (acad_strlsort LBL))

(alert "You have not any blocks in a drawing ")

)

(if LBL LBL NIL)

)

;;;

;;;

;;;

(defun C:MBL ( / FIRSTNAME LBL PTH X CMD INC)

(setq INC 0

LBL (BLOCK_LIST)

)

(if

(= NIL LBL)

(princ "\nDone. ")

(progn

(setq FIRSTNAME

(getfiled "Select Export Directory" (car LBL) "dwg" 15)

)

(if FIRSTNAME

(progn

(setq PTH (car (fnsplitl FIRSTNAME)))

(setq CMD (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

(foreach X LBL

(if

(findfile (strcat PTH X ".dwg"))

(command "_.WBLOCK" (strcat PTH X) "_N")

(progn

(command "_.WBLOCK" (strcat PTH X) "=")

(princ ".")

(setq INC (1+ INC))

)

)

)

(setvar "CMDECHO" CMD)

)

(princ "\nDone. ")

)

)

)

(if PTH

(alert

(strcat "\nWriten "

(itoa INC)

" blocks in cirectory "

(strcase PTH)

)

)

)

(princ)

)

;;;

;;;

;;;

(princ)
(princ "\n Export All blocks in Drawing - MBL.")
(princ)

(c:mbl)

Advertisements