;;;CADALYST 01/05 Tip2015: BLCX.lsp Block counter (c) Alexander Smirnov

(defun c:blcx(/ blSet blList nameList listLen outList exFlag oldExFlag
exPath exApp exWorkbook exFileexSheets exSheet curId
newFile curCell curVal)

;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;; +
;;; This program counts blocks, gives out the reporting, +
;;; and also can export the data to MS Excel. +
;;; +
;;; Type BLCX in command line to run. +
;;; +
;;; Supported O/S: Windows 2000/XP +
;;; Suppported MS Excel Versions: MS Office 97/2003 +
;;; Supported AutoCAD Versions: AutoCAD 2000/2005 +
;;; +
;;; Writen by Fantom (Alexander Smirnov) asmirnov@inbox.lv +
;;; +
;;; Version 1.0 Dec 09, 2004 +
;;; +
;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(vl-load-com)

(princ "\n*** Specify selection set by frame selection ***")
(if(setq blSet(ssget '((0 . "INSERT"))))
(progn
(setq blList(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex blSet))))
nameList(vl-sort (mapcar'(lambda(X)(vla-get-Name x)) blList) '<)
listLen(length nameList)
); end setq
(while nameList
(setq outList (cons(cons(car nameList)
(- listLen(setq listLen(length (setq nameList
(vl-remove(car nameList) nameList))))))outList)
); end setq
) ; end while
(princ "\n********** BLOCK COUNTING REPORT ************\n ")
(foreach item outList
(princ(strcat "\n" (car item)" "(itoa(cdr item))))
); end foreach
(princ "\n \n************* END OF REPORT *****************")
(textscr)
(if(not exFlag)(setq exFlag "N"))
(setq oldExFlag exFlag)
(initget "Y N")
(setq exFlag
(getkword
(strcat "\n\n*** Save report to MS Excel file? [Y/N] : ")))
(if(null exFlag)(setq exFlag oldExFlag))
(if(= exFlag "Y")
(progn
(if (setq exPath(getfiled "Save Text File As"
(strcat (getvar "dwgprefix")(substr (getvar "dwgname") 1
(- (strlen (getvar "dwgname")) 4)) ".xls")"xls" 33); end getfiled
); end setq
(progn
(setq exApp(vlax-create-object "Excel.Application"))
(if(null exApp)
(progn
(alert "Error. Can't start MS Excel.")
(quit)
); end progn
); end if
(setq exWorkbook
(vlax-get-property exApp "Workbooks")
exFile
(vlax-invoke-method exWorkbook "Add")
exSheets
(vlax-get-property exFile "Worksheets")
exSheet
(vlax-get-property exSheets "Item" "Sheet1")
curRow 2
); end setq
(repeat(length outList)
(setq curId(strcat "B"(itoa curRow))
curCell(vlax-variant-value
(vlax-invoke-method exSheet "Evaluate" curId))
curVal(car(nth(- curRow 2) outList))
); end setq
(vlax-put-property curCell "Formula" curVal)
(vlax-release-object curCell)
(setq curId(strcat "C"(itoa curRow))
curCell(vlax-variant-value
(vlax-invoke-method exSheet "Evaluate" curId))
curVal(itoa(cdr(nth(- curRow 2) outList)))
); end setq
(vlax-put-property curCell "Formula" curVal)
(vlax-release-object curCell)
(setq curRow(1+ curRow))
); end repeat
(vlax-invoke-method exFile "SaveAs" exPath nil nil nil nil nil nil)
(vlax-invoke-method exFile "Close" nil)
(vlax-invoke-method exApp "Quit")
(mapcar(function(lambda(x)
(if
(and x(not(vlax-object-released-p x)))
(vlax-release-object x)
)
))
(list curCell exSheet exSheets exFile exWorkbook exApp)
)
(setq curCell nil
exSheet nil
exSheets nil
exFile nil
exWorkbook nil
exApp nil); end setq
(gc)
(princ(strcat"\n*** The file was successfully saved in: " exPath))
); end progn
(princ "\n*** Excel file was not created! *** ")
); end if
); end progn
); end if
); end progn
(princ "\n*** Nothing blocks selected! ***")
); end if
(princ)
); end of BLCX

(princ "\nType BLCX to run.")

(c:BLCX)

Advertisements