stevsmith Posted April 19, 2010 Posted April 19, 2010 I don't know if this falls under the lisp category, but I'm sure it would end up here anyway. Is there a way to count the number of blocks in a drawing without the use of data extraction. Ideally I would like to have it appear in the Q-properties window when I click on the block in question, but there doesn't seem to be this type of option in the cui for this to happen. Ideally what I would like is, I'd to click on the block in question and information regarding how many of these blocks are in the current model space. Kind of similar to LeeMac's DYNinfo lisp. Quote
alanjt Posted April 19, 2010 Posted April 19, 2010 I was going to suggest BCount, except that you have to select each block, or select ALL blocks... (defun c:Test (/ ent) (and (setq ent (car (entsel "\nSelect block: "))) (or (eq "INSERT" (cdr (assoc 0 (entget ent)))) (alert "Invalid object!") ) (alert (strcat (itoa (sslength (ssget "_X" (list '(0 . "INSERT") (assoc 2 (entget ent)) (if (eq 2 (getvar "cvport")) (cons 410 "Model") (cons 410 (getvar "ctab")) ) ) ) ) ) " occurances of block \"" (cdr (assoc 2 (entget ent))) "\" within current layout." ) ) ) (princ) ) Quote
stevsmith Posted April 19, 2010 Author Posted April 19, 2010 Thanks Alan, I was kind of puzzled by the bcount to start off with. I'll give your lisp a crack tomorrow as I've finished work now. Cheers Quote
Lee Mac Posted April 19, 2010 Posted April 19, 2010 stevsmith said: Kind of similar to LeeMac's DYNinfo lisp. I think my LISP actually has this field when you move over a block As an alternative, I wrote this a while back, should count nested occurrences too: ;; Block Counter by Lee McDonnell (Lee Mac) ~ 22.08.2009 ;; Copyright © August 2009 ;; Will Count all instances of a block, including nested. (defun BlkCount (Blk / i j ss *blk) (vl-load-com) (setq i 0 Blk (strcase Blk) j -1 *blk (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) (defun GetNest (Obj Nme) (and (eq (strcase (vla-get-Name Obj)) Nme) (setq i (1+ i))) (vlax-for Sub Obj (if (eq "AcDbBlockReference" (vla-get-ObjectName Sub)) (GetNest (vla-item *blk (vla-get-EffectiveName Sub)) Nme)))) (if (setq ss (ssget "_X" '((0 . "INSERT")))) (while (setq ent (ssname ss (setq j (1+ j)))) (GetNest (vla-item *blk (vla-get-EffectiveName (vlax-ename->vla-object ent))) Blk))) i) (defun c:test (/ str lst tdef) (while (progn (setq str (getstring t "\nSpecify Block Name <All> : ")) (cond ((eq "" str) (while (setq tdef (tblnext "BLOCK" (null tdef))) (setq lst (cons (cdr (assoc 2 tdef)) lst))) (setq lst (vl-remove-if (function (lambda (x) (wcmatch x "`**"))) lst)) nil) ((and (snvalid str) (tblsearch "BLOCK" str)) (setq lst (list str)) nil) (t (princ "\n** Block not Found **"))))) (setq mstr (+ 5 (apply 'max (mapcar 'strlen lst)))) (princ (strcat (Pad "\n Block" 32 mstr) "| Count")) (princ (strcat (Pad "\n " 45 mstr) (Pad "|" 45 10))) (foreach x lst (setq i (Blkcount x)) (princ (strcat (Pad (strcat "\n " x) 46 mstr) (Pad "|" 46 (- 10 (strlen (itoa i)))) (itoa i)))) (princ)) (defun Pad (Str Chc Len) (while (< (strlen Str) Len) (setq Str (strcat Str (chr Chc)))) Str) Needs tidying up and probably isn't the best way to approach it... :S Quote
dbroada Posted April 19, 2010 Posted April 19, 2010 what about QSELECT? Select block by name and F2 or use the properties palette to see how many were selected. Quote
Lee Mac Posted April 19, 2010 Posted April 19, 2010 Another for consideration [i][color=#990099];; Block Counter (Lee Mac)[/color][/i] [i][color=#990099];; Will produce a report of the number of[/color][/i] [i][color=#990099];; each block in all layouts.[/color][/i] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:BNum [b][color=RED]([/color][/b] [b][color=BLUE]/[/color][/b] bLst rLen [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b] [i][color=#990099];; Lee Mac ~ 19.04.10[/color][/i] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bLst [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] block [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] block [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b]BlockList [b][color=#009900]125[/color][/b][b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bLst [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] item [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] item[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]itoa[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] item[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-for[/color][/b] lay [b][color=RED]([/color][/b][b][color=BLUE]vla-get-layouts[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-for[/color][/b] obj [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Block[/color][/b] lay[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#a52a2a]"AcDbBlockReference"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-property[/color][/b] obj [b][color=DARKRED]'[/color][/b]ObjectName[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] a [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=RED]([/color][/b]BlockName obj[b][color=RED])[/color][/b] bLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bLst [b][color=RED]([/color][/b][b][color=BLUE]subst[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] a[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] a[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] a bLst [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] bLst [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] rLen [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] [b][color=#009900]3[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]apply[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]max[/color][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]5[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]strlen[/color][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]cdr[/color][color=RED])[/color][/b] bLst[b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] item [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\n"[/color][/b] [b][color=RED]([/color][/b]PadRight [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] item[b][color=RED])[/color][/b] [b][color=#a52a2a]"."[/color][/b] [b][color=#009900]40[/color][/b][b][color=RED])[/color][/b] [b][color=#a52a2a]"|"[/color][/b] [b][color=RED]([/color][/b]PadLeft [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] item[b][color=RED])[/color][/b] [b][color=#a52a2a]"."[/color][/b] rLen[b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#a52a2a]"Block Name"[/color][/b] . [b][color=#a52a2a]"Count"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b]PadRight [b][color=#a52a2a]""[/color][/b] [b][color=#a52a2a]"-"[/color][/b] [b][color=#009900]40[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]PadLeft [b][color=#a52a2a]""[/color][/b] [b][color=#a52a2a]"-"[/color][/b] rLen[b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-sort[/color][/b] bLst [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] a b [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] a[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] b[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] BlockName [b][color=RED]([/color][/b] obj [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-property[/color][/b] obj [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-property-available-p[/color][/b] obj [b][color=DARKRED]'[/color][/b]EffectiveName[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b]EffectiveName [b][color=DARKRED]'[/color][/b]Name [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] BlockList [b][color=RED]([/color][/b] ignore [b][color=BLUE]/[/color][/b] def lst [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] def [b][color=RED]([/color][/b][b][color=BLUE]tblnext[/color][/b] [b][color=#a52a2a]"BLOCK"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]null[/color][/b] def[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]zerop[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]boole[/color][/b] [b][color=#009900]1[/color][/b] ignore [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]70[/color][/b] def[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lst [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]2[/color][/b] def[b][color=RED])[/color][/b][b][color=RED])[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] lst [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] TidyString [b][color=RED]([/color][/b] str len [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strlen[/color][/b] str[b][color=RED])[/color][/b] len[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]substr[/color][/b] str [b][color=#009900]1[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] len [b][color=#009900]3[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#a52a2a]"..."[/color][/b] [b][color=RED])[/color][/b] str [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] PadRight [b][color=RED]([/color][/b] str char len [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strlen[/color][/b] str[b][color=RED])[/color][/b] len[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] str [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] str char[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED])[/color][/b] str [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] PadLeft [b][color=RED]([/color][/b] str char len [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strlen[/color][/b] str[b][color=RED])[/color][/b] len[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] str [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] char str[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED])[/color][/b] str [b][color=RED])[/color][/b] Quote
asos2000 Posted April 19, 2010 Posted April 19, 2010 Give this one a try, i do not rememebr where I get. this routine creates a table. ;;; ability to drag an move a vla object ;;; msg: optional message by default uses "Move" ((defun drag-move (msg vla_obj / take code5 p3) (prompt (strcat "\n" (cond (msg) ("Move")) "\n")) (while (and (setq take (grread 't)) (/= 3 (car take))) (setq code5 (car take)) (setq p3 (cadr take)) (if (and p3 (= 5 code5)) (vla-move vla_obj (vla-get-insertionpoint vla_obj) (vlax-3d-point p3))))) (defun C:BLKQTY (/ table_headers table_rows vla_table column row lst docblocks ss i ename obj) (vl-load-com) (if (setq ss (ssget "x" (list (cons 0 "INSERT")))) (progn (setq docblocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (setq i 0) (repeat (sslength ss) (setq ename (ssname ss i)) (setq obj (vlax-ename->vla-object ename)) (if (not (vl-position (vla-get-name obj) lst)) (progn (setq lst (cons (vla-get-name obj) lst)) (setq table_rows (cons (list (vla-get-name obj) (vla-get-count (vla-item docblocks (vla-get-name obj))) (vla-get-objectid (vla-item docblocks (vla-get-name obj)))) table_rows)))) (setq i (1+ i))) ;; headers list (setq table_headers (list "Block Preview" "Block Name" "Quantity")) ;; object Table (setq vla_table (vla-addtable ;; for test place the object on model space (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) ;; base = 0,0,0 (vlax-3d-point (list 0 0 0)) ;; rows number - including title & headers (+ (length table_rows) 2) ;; columns number (length table_headers) ;; row height 10.0 ;; column width 10.0)) ;; set title name (vla-settext vla_table 0 0 "Block Quantity") ;; cell alignment (vla-setcellalignment vla_table 0 0 acmiddlecenter) ;; cell text height (vla-setcelltextheight vla_table 0 0 220) ;; first column (setq column 0) ;; generates all headers (foreach item table_headers ;; header (vla-settext vla_table 1 column item) ;; alignment (vla-setcellalignment vla_table 1 column acmiddlecenter) ;; text height (vla-setcelltextheight vla_table 1 column 220) ;; next column (setq column (1+ column))) ;; start with row 2 (setq row 2) ;; first column (setq column 0) ;; generate all rows (foreach item table_rows (vla-SetBlockTableRecordId vla_table row 0 (last item) :vlax-true) (vla-setcellalignment vla_table row 0 acmiddlecenter) ;; cell text (vla-settext vla_table row 1 (car item)) ;; alignment (vla-setcellalignment vla_table row 1 acmiddlecenter) ;; text height (vla-setcelltextheight vla_table row 1 220) ;; cell text (vla-settext vla_table row 2 (itoa (cadr item))) ;; alignment (vla-setcellalignment vla_table row 2 acmiddlecenter) ;; text height (vla-setcelltextheight vla_table row 2 220) ;; next row (setq row (1+ row))) (drag-move nil vla_table))) (princ))) Quote
stevsmith Posted April 20, 2010 Author Posted April 20, 2010 Alan, Your lisp worked great, It's exactly what I was looking for. A quick reliable counter. Lee, your lisp will come in very handy for larger jobs that I have to deal with. Asos, your lisps output seems corrupted. It has a good idea of a block preview in the table, but alot of the data was jumbled. i like the idea of the table in the drawing though. Quote
asos2000 Posted April 20, 2010 Posted April 20, 2010 yes and I hope one of coder to update this routine Quote
asos2000 Posted April 20, 2010 Posted April 20, 2010 alanjt - Nice idea could I use? - Not working with DB LEE - good routine but takes long time. Quote
Lee Mac Posted April 20, 2010 Posted April 20, 2010 asos2000 said: LEE - good routine but takes long time. Which routine were you referring to? The latest? Quote
asos2000 Posted April 20, 2010 Posted April 20, 2010 First one takes long time and this is the result Command: test Specify Block Name <All> : Block | Count ------------------------------------------------------------------------------- --------------------------|--------- EC-standards................................................................... ..........................|........0 Xref-EC-BS-FRAME|EC-BASRAH-TITLE............................................... second one gives an error Command: BNUM _.layer Current layer: "EC-SEC-ELEV" Enter an option [?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock /stAte]: set Enter layer name to make current or <select object>: Enter an option [?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock /stAte]: Command: ; error: An error has occurred inside the *error* functionAutoCAD variable setting rejected: "cmdecho" nil Quote
Lee Mac Posted April 20, 2010 Posted April 20, 2010 I expected the first one to take a long time - it is due to the way it is coded. As for the second, I cannot understand your output, as the code does not even have an error function, and does not deal with layers. Quote
alanjt Posted April 20, 2010 Posted April 20, 2010 stevsmith said: Alan, Your lisp worked great, It's exactly what I was looking for. A quick reliable counter. Glad it helps. It was a quickie. asos2000 said: alanjt- Nice idea could I use? - Not working with DB LEE - good routine but takes long time. It's all yours. Quote
asos2000 Posted April 20, 2010 Posted April 20, 2010 Could be inserted in the table, Let me try to code it. But one question How to get the blocks number to get use in specify how many rows will be used? Quote
Lee Mac Posted April 20, 2010 Posted April 20, 2010 Another to play with ;; Block Counter (Lee Mac) ;; Will produce a report and table of the number of each block in the drawing. ;; Includes Dyn Blocks, excludes Xrefs - and yes, I know there is BCount. ;; Also lists blocks with zero count - Purge warning? (defun c:BNum ( / bLst rLen ) (vl-load-com) ;; Lee Mac ~ 21.04.10 (setq bLst (mapcar (function (lambda ( block ) (list block 0) ) ) (BlockList 125) ) ) (setq bLst (mapcar (function (lambda ( item ) (list (car item) (itoa (cadr item)) ) ) ) (vlax-for lay (vla-get-layouts (vla-get-ActiveDocument (vlax-get-acad-object) ) ) (vlax-for obj (vla-get-Block lay) (if (and (eq "AcDbBlockReference" (vlax-get-property obj 'ObjectName)) (not (isXRef obj))) (progn (setq a (assoc (BlockName obj) bLst)) (setq bLst (subst (list (car a) (1+ (cadr a))) a bLst ) ) ) ) bLst ) ) ) ) (setq rLen (+ 3 (apply (function max) (cons 5 (mapcar (function strlen) (mapcar (function cadr) bLst) ) ) ) ) ) (mapcar (function (lambda ( item ) (princ (strcat "\n" (PadRight (car item) "." 40) "|" (PadLeft (cadr item) "." rLen) ) ) ) ) (setq bLst (cons '("Block Name" "Count") (cons (list (PadRight "" "-" 40) (PadLeft "" "-" rLen) ) (append (vl-sort bLst (function (lambda ( a b ) (< (car a) (car b)) ) ) ) (list (list (PadRight "" "-" 40) (PadLeft "" "-" rLen) ) ) ) ) ) ) ) (GrMove (AddTable (GetActiveSpace (vla-get-ActiveDocument (vlax-get-acad-object) ) ) (getvar 'VIEWCTR) "Block Data" (RemoveItems bLst (list 1 (1- (length bLst)))) ) 'InsertionPoint "\nPlace Table... " 0 ) (princ) ) (defun BlockName ( obj ) (vlax-get-property obj (if (vlax-property-available-p obj 'EffectiveName) 'EffectiveName 'Name ) ) ) (defun isXref ( obj ) (eq :vlax-true (vlax-get-property (Itemp (cond (blocks) ( (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object) ) ) ) ) (BlockName obj) ) 'isXRef ) ) ) (defun BlockList ( ignore / def lst ) (while (setq def (tblnext "BLOCK" (null def))) (if (zerop (boole 1 ignore (cdr (assoc 70 def)))) (setq lst (cons (cdr (assoc 2 def)) lst)) ) ) lst ) (defun GetActiveSpace ( doc ) (vlax-get-property doc (if (or (eq acModelSpace (vla-get-ActiveSpace doc)) (eq :vlax-true (vla-get-MSpace doc))) 'ModelSpace 'PaperSpace ) ) ) (defun RemoveItems ( lst items ) ( (lambda ( item ) (vl-remove-if (function (lambda ( x ) (vl-position (setq item (1+ item)) items ) ) ) lst ) ) -1 ) ) (defun Itemp ( coll item ) (if (not (vl-catch-all-error-p (setq item (vl-catch-all-apply (function vla-item) (list coll item) ) ) ) ) item ) ) (defun AddTable ( block pt title data / tObj ) (vlax-put-property (setq tObj (vla-AddTable block (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.5 (getvar 'TEXTSIZE)) (* 1.5 (apply (function max) (mapcar (function strlen) (apply (function append) data) ) ) ) ) ) 'StyleName (getvar 'CTABLESTYLE) ) (vla-SetText tObj 0 0 title) ( (lambda ( row ) (mapcar (function (lambda ( rowitem ) (setq row (1+ row)) ( (lambda ( column ) (mapcar (function (lambda ( item ) (vla-SetText tObj row (setq column (1+ column)) item ) ) ) rowitem ) ) -1 ) ) ) data ) ) 0 ) tObj ) (defun GrMove ( obj prop msg cur / gr data ) (if (vlax-property-available-p obj prop) (progn (princ msg) (while (and (= 5 (car (setq gr (grread t 13 cur)))) (listp (setq data (cadr gr)))) (vlax-put-property obj prop (vlax-3D-point data)) ) data ) ) ) (defun TidyString ( str len ) (if (> (strlen str) len) (strcat (substr str 1 (- len 3)) "..." ) str ) ) (defun PadRight ( str char len ) (while (< (strlen str) len) (setq str (strcat str char)) ) str ) (defun PadLeft ( str char len ) (while (< (strlen str) len) (setq str (strcat char str)) ) str ) Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.