I am trying to modify Lee's Block Count Routine. To simply have the routine explode all dynamic blocks, then grab all the blocks on a layer.
I know I was just messing around with the following, but thought it would be easier just to place it in the beginning of his routine, but having a hard time figuring out where to put it.
(defun c:pre-run ()
(C:ExplodeDynamicBlocks)
(C:isoparking)
(C:Count)
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:ExplodeDynamicBlocks ( / ssAll drwordr)
(setq ssAll (ssget "X" '((0 . "INSERT")(2 . "`*U*")))
drwordr (getvar "draworderctl")
)
(setvar "draworderctl" 0);supress warnings
(sssetfirst nil ssAll) ;makes ssAll both gripped and selected.
(c:burst)
(setvar "draworderctl" drwordr));end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:isoparking ( / lay seliso )
(setq lay "0,C-PRKG*")
(if (setq seliso (ssget "_X" (list (cons 8 lay) (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
(command "_.layiso" seliso "")
)
(princ))
;;--------------=={ Count.lsp - Advanced Block Counter }==--------------;;
;; ;;
;; This program enables the user to record the quantities of a ;;
;; selection or all standard or dynamic blocks in the working drawing. ;;
;; The results of the block count may be displayed at the AutoCAD ;;
;; command-line, written to a Text or CSV file, or displayed in an ;;
;; AutoCAD Table, where available. ;;
;; ;;
;; Upon issuing the command syntax 'count' at the AutoCAD ;;
;; command-line, the user is prompted to make a selection of standard ;;
;; or dynamic blocks to be counted by the program. At this prompt, ;;
;; the user may right-click or press 'Enter' to automatically count ;;
;; all blocks in the drawing. ;;
;; ;;
;; Depending on the output setting, the results may then be printed ;;
;; to the AutoCAD command-line and displayed in the Text Window, or ;;
;; the user will be prompted to specify an insertion point for the ;;
;; table, or a filename & location for the Text or CSV output file. ;;
;; ;;
;; The program settings may be configured using the 'countsettings' ;;
;; command; this command will present the user with a dialog interface ;;
;; through which the data output, table & file headings, displayed ;;
;; columns, sorting field & sort order may each be altered. ;;
;;----------------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2014 - www.lee-mac.com ;;
;;----------------------------------------------------------------------;;
;; Version 1.0 - 2010-06-05 ;;
;; ;;
;; - First release. ;;
;;----------------------------------------------------------------------;;
;; Version 1.1 - 2010-06-06 ;;
;; ;;
;; - Updated code to include Settings dialog. ;;
;; - Added Undo Marks. ;;
;;----------------------------------------------------------------------;;
;; Version 1.2 - 2010-06-06 ;;
;; ;;
;; - Fixed bug with 64-bit systems. ;;
;;----------------------------------------------------------------------;;
;; Version 1.3 - 2011-03-02 ;;
;; ;;
;; - Program completely rewritten. ;;
;; - Updated code to work without error on 64-bit systems by fixing ;;
;; bug with ObjectID subfunction - my thanks go to member 'Jeff M' ;;
;; at theSwamp.org forums for helping me solve this problem. ;;
;; - Added ability to write block count to Text/CSV Files. ;;
;;----------------------------------------------------------------------;;
;; Version 1.4 - 2014-06-15 ;;
;; ;;
;; - Program completely rewritten. ;;
;;----------------------------------------------------------------------;;
;; Version 1.5 - 2015-06-07 ;;
;; ;;
;; - Minor update to enable full compatibility with ZWCAD. ;;
;; (regeneratetablesuppressed property not available) ;;
;;----------------------------------------------------------------------;;
(setq
count:version "1-5"
count:defaults
'(
(out "tab")
(tg1 "1")
(tg2 "1")
(tg3 "1")
(ed1 "Block Data")
(ed2 "Preview")
(ed3 "Block Name")
(ed4 "Count")
(srt "blk")
(ord "asc")
)
)
;;----------------------------------------------------------------------;;
(defun count:fixdir ( dir )
(vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir))
)
;;----------------------------------------------------------------------;;
(defun count:getsavepath ( / tmp )
(cond
( (setq tmp (getvar 'roamablerootprefix))
(strcat (count:fixdir tmp) "\\Support")
)
( (setq tmp (findfile "acad.pat"))
(count:fixdir (vl-filename-directory tmp))
)
( (count:fixdir (vl-filename-directory (vl-filename-mktemp))))
)
)
;;----------------------------------------------------------------------;;
(setq count:savepath (count:getsavepath) ;; Save path for DCL & Config files
count:dclfname (strcat count:savepath "\\LMAC_count_V" count:version ".dcl")
count:cfgfname (strcat count:savepath "\\LMAC_count_V" count:version ".cfg")
)
;;----------------------------------------------------------------------;;
(defun c:count
(
/
*error*
all
col
des dir
ed1 ed2 ed3 ed4
fil fnm fun
hgt
idx ins
lst
ord out
row
sel srt
tab tg1 tg2 tg3 tmp
xrf
)
(defun *error* ( msg )
(if (= 'file (type des))
(close des)
)
(if (and (= 'vla-object (type tab))
(null (vlax-erased-p tab))
(= "AcDbTable" (vla-get-objectname tab))
(vlax-write-enabled-p tab)
(vlax-property-available-p tab 'regeneratetablesuppressed t)
)
(vla-put-regeneratetablesuppressed tab :vlax-false)
)
(if (and (= 'vla-object (type count:wshobject))
(not (vlax-object-released-p count:wshobject))
)
(progn
(vlax-release-object count:wshobject)
(setq count:wshobject nil)
)
)
(count:endundo (count:acdoc))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)
(if (not (findfile count:cfgfname))
(count:writecfg count:cfgfname (mapcar 'cadr count:defaults))
)
(count:readcfg count:cfgfname (mapcar 'car count:defaults))
(foreach sym count:defaults
(if (not (boundp (car sym))) (apply 'set sym))
)
(if (and (= "tab" out) (not (vlax-method-applicable-p (vla-get-modelspace (count:acdoc)) 'addtable)))
(setq out "txt")
)
(count:startundo (count:acdoc))
(while (setq tmp (tblnext "block" (null tmp)))
(if (= 4 (logand 4 (cdr (assoc 70 tmp))))
(setq xrf (vl-list* "," (cdr (assoc 2 tmp)) xrf))
)
)
(if xrf
(setq fil (list '(0 . "INSERT") '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr xrf))) '(-4 . "NOT>")))
(setq fil '((0 . "INSERT")))
)
(cond
( (null (setq all (ssget "_X" fil)))
(count:popup
"No Blocks Found" 64
(princ "No blocks were found in the active drawing.")
)
)
( (and (= "tab" out) (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer)))))))
(count:popup
"Current Layer Locked" 64
(princ "Please unlock the current layer before using this program.")
)
)
( (progn
(setvar 'nomutt 1)
(princ "\nSelect blocks to count <all>: ")
(setq sel
(cond
( (null (setq sel (vl-catch-all-apply 'ssget (list fil))))
all
)
( (null (vl-catch-all-error-p sel))
sel
)
)
)
(setvar 'nomutt 0)
(null sel)
)
)
( (or (= "com" out)
(and (= "tab" out) (setq ins (getpoint "\nSpecify point for table: ")))
(and (/= "tab" out)
(setq fnm
(getfiled "Create Output File"
(cond
( (and (setq dir (getenv "LMac\\countdir"))
(vl-file-directory-p (setq dir (count:fixdir dir)))
)
(strcat dir "\\")
)
( (getvar 'dwgprefix))
)
out 1
)
)
)
)
….
….
...