Jump to content

Lisp to count blocks on specific layers


chee_dee

Recommended Posts

How do i manipulate this lisp to count blocks on specific layers only?

 

All my layers start with "E_..." eg E_POWER, E_LIGHTS etc.

 

I got this lisp from the site and it works like a dream... would help even more if if can be changed to recognise and count the blocks only on the layers with names starting with "E_..."

 

Thanks

 

;*******************************************************************************

;* C:BlocksList.LSP *

;* *

;* *

;*******************************************************************************

(defun C:BlocksList ( ; Command emulation; (8) local variables

/ Option ; User option for output of block quantities (or exit)

C_layer ; Current layer's name con'd with its assoc key (8)

Block_list ; List of block's table information

Block_cons ; List of block's name con'd with 2 (its assoc key)

Block_set ; Selection set of all blocks with given name (& on curr layer)

Block_name ; Current block's name

Block_srch ; Search criteria for finding/selecting blocks

Count$ ; Quantity of selected blocks as a string value

) ; Close defun's local variables list

(cond ; Begin routine--get user input first

( (initget "All Current eXit") ) ; Initialize options for user input

( (= "eXit" (setq Option (getkword (strcat "List ["

"All occurrences/Current layer only/eXit" "] : "

) ) ) ) ); Default is do blocks on current layer

(T(textscr) (prompt "\nPlease wait...Counting block insertions...Found...")

(if (/= Option "All") (setq C_layer (cons 8 (getvar "CLAYER"))))

(while ; Inform user processing is starting

(setq Block_list (tblnext "BLOCK" (not Block_list)))

(setq Block_cons (assoc 2 Block_list)

Block_name (cdr Block_cons)

Block_srch (cond ; Step through entire block name database

( (= (ascii Block_name) 42) nil ); Ignore anonymous blocks: "*..."

( (= Option "All") (list Block_cons) )

(T(list Block_cons C_layer) )

) ) ; Limit to current layer if All not opted

(cond ; Now output (ignores unused blocknames)

( (and Block_srch (setq Block_set (ssget "X" Block_srch)))

(setq Count$ (rtos (sslength Block_set) 2 0))

(prompt (strcat "\n" " " ; Build prompt string--pretty-print qty

(nth (strlen Count$) '("" " " " " " " " " " " ""))

Count$ " " Block_name ; Output qty & block name to screen

) ) ) ; Close cond's only opt & prompt-strcat

) ) ; Close processing while & its cond

) ) ; Close main cond & its T option

(princ) ; Quiet exit

) ; The END (close defun C:BlocksList)

(C:BlocksList) ; Auto-call @ actual, not dummy, load

Link to comment
Share on other sites

(defun c:test (/ SS)
 (if (setq SS (ssget "_X"
	      (list (cons 0 "INSERT") (cons 410 (getvar "CTAB")) (cons 8 "E_*"))
       )
     )
   (prompt (strcat "\nTotal " (itoa (sslength SS)) " blocks."))
 )
 (princ)
)

Link to comment
Share on other sites

Here is a mod of your routine.

;;********************
;;*                  *
;;* C:BlocksList.LSP *
;;*                  *
;;********************
(defun C:BlocksList (                   ; Command emulation; ( local variables 
                    /            Option; User option for output of block quantities (or exit) 
                    C_layer            ; Current layer's name con'd with its assoc key ( 
                    Block_list         ; List of block's table information 
                    Block_cons         ; List of block's name con'd with 2 (its assoc key) 
                    Block_set          ; Selection set of all blocks with given name (& on curr layer)
                    Block_name         ; Current block's name 
                    Block_srch         ; Search criteria for finding/selecting blocks 
                    Count$             ; Quantity of selected blocks as a string value
                    Pattern            ; Wild Card match layer name
                   )                   ; Close defun's local variables list
 (cond                                 ; Begin routine--get user input first 
   ((initget "All Current Pattern eXit"))      ; Initialize options for user input 
   ((= "eXit"
       (setq
         Option (getkword
                  (strcat "List ["
                          "All occurrences/Current layer only/Pattern/eXit"
                          "] <Current layer only>: "
                  )
                )
       )
    )
   )                                   ; Default is do blocks on current layer 
   (T
    (if (= Option "Pattern") ; Wild Card match
      (while (= (vl-string-trim " \t\n"
                  (setq Pattern (getstring t "\nEnter Layer name pattern. "))) "")
        (prompt "\nYou must enter a layer name.")
      )
    )
    (textscr)
    (prompt
      "\nPlease wait...Counting block insertions...Found..."
    )
    (cond
      ((= Option "All"))
      ((= Option "Pattern")(setq C_layer (cons 8 Pattern)))
      ((setq C_layer (cons 8 (getvar "CLAYER"))))
    )
    (while                             ; Inform user processing is starting 
      (setq Block_list (tblnext "BLOCK" (not Block_list)))
       (setq Block_cons (assoc 2 Block_list)
             Block_name (cdr Block_cons)
             Block_srch (cond          ; Step through entire block name database
                          ((= (ascii Block_name) 42) nil)
                                       ; Ignore anonymous blocks: "*..." 
                          ((= Option "All") (list Block_cons))
                          (T (list Block_cons C_layer))
                        )
       )                               ; Limit to current layer if All not opted
       (cond                           ; Now output (ignores unused blocknames) 
         ((and Block_srch (setq Block_set (ssget "X" Block_srch)))
          (setq Count$ (itoa (sslength Block_set)))
          (prompt
            (strcat "\n"               ; Build prompt string--pretty-print qty 
                    (substr "      " 1 (- 6 (strlen Count$)))
                    Count$
                    " "
                    Block_name         ; Output qty & block name to screen 
            )
          )
         )                             ; Close cond's only opt & prompt-strcat 
       )
    )                                  ; Close processing while & its cond
    (or Count$ (prompt "\n**< None Found >**"))
   )
 )                                     ; Close main cond & its T option 
 (princ)                               ; Quiet exit 
)                                       ; The END (close defun C:BlocksList) 
(C:BlocksList)                          ; Auto-call @ actual, not dummy, load 

Link to comment
Share on other sites

Thanks, it works.

 

I do have 1 Minor problem though... There's a Block Named "UnderFloorHeating"... now if I use the lisp and select "All ocurances" it counts 17.

 

But if I do a quickselect, there are 21... they are all on the same layer but the lisp can't seem to count em.

 

Any help?

Link to comment
Share on other sites

Saveing DWG back to ACAD2000, this is what I got.

No blocks named "UnderFloorHeating"

Command: blockslist
List [All occurrences/Current layer only/Pattern/eXit] <Current layer only>: a

Please wait...Counting block insertions...Found...
    6 Double Fluorescent
  358 Downlighter
   20 1 Lever Switch
   60 DimmerSwitch
   26 2 Way Switching
    9 Ceiling Mount Light
    7 Shaver Socket
    9 UpDown Wall Mounted Light
    3 Distribution Board
    6 Internal Wall Mounted Light
    2 Pendant Light
   11 Garden Light
    3 Pool Light
   70 Double Switched Socket
   24 Single Switched Socket
    3 Intermediate Switch
    3 Enclosure
    6 External Wall Mounted Light
    3 Stove Isolator
    7 Weather Proof Plug

 

And using another routine:

Command: blkcount
(("*U10" . 17) 
("*U17" . 4) 
("*U21" . 11) 
("*U9" . 7) 
("1 Lever Switch" . 20) 
("2 Way Switching" . 26) 
("Ceiling Mount Light" . 9) 
("DimmerSwitch" . 60) 
("Distribution Board" . 3) 
("Double Fluorescent" . 6) 
("Double Switched Socket" . 70) 
("Downlighter" . 358) 
("Enclosure" . 3) 
("External Wall Mounted Light" . 6) 
("Garden Light" . 11) 
("Intermediate Switch" . 3) 
("Internal Wall Mounted Light" . 6) 
("Pendant Light" . 2) 
("Pool Light" . 3) 
("Shaver Socket" . 7) 
("Single Switched Socket" . 24) 
("Stove Isolator" . 3) 
("UpDown Wall Mounted Light" . 9) 
("Weather Proof Plug" . 7))

Link to comment
Share on other sites

Here's what I get

 

Command:
Current block modes: Unused = IGNORE,  Anonymous = IGNORE, Layers = ALL
Send report to [Printer/Screen/File/Unused/Anonymous/Layers/eXit] <c:\documents 
and settings\design.desktop\desktop\ufh-test.blk>: S
Please wait...Counting block inserts...
Writing results to: Text Window
       6    Double Fluorescent
     358    Downlighter
      20    1 Lever Switch
      60    DimmerSwitch
      26    2 Way Switching
       9    Ceiling Mount Light
       7    Shaver Socket
       7    Heated Towel Rail
      17    UnderFloorHeating
       9    UpDown Wall Mounted Light
       3    Distribution Board
       6    Internal Wall Mounted Light
       2    Pendant Light
      11    Garden Light
       3    Pool Light
      70    Double Switched Socket
      24    Single Switched Socket
       3    Intermediate Switch
      11    Aircon Point
       3    Enclosure
       6    External Wall Mounted Light
       3    Stove Isolator
       7    Weather Proof Plug

Link to comment
Share on other sites

That's weird...I get 17 using BCOUNT also. Qselect gives 21 and there are 21 in the drawing. For some reason, the block counter LISPs do not recognize 4 of the blocks. :?

 

Command: [size=3][b]bcount
[/b][/size]
Initializing...
Press Enter to select all or...
Select objects:

Block............................Count
--------------------------------------
Double Fluorescent...............6
Distribution Board...............3
Pendant Light....................2
Internal Wall Mounted Light......6
UpDown Wall Mounted Light........9
Ceiling Mount Light..............9
2 Way Switching..................26
Garden Light.....................11
Pool Light.......................3
Downlighter......................358
Shaver Socket....................7
Heated Towel Rail................7
DimmerSwitch.....................60
Intermediate Switch..............3
Double Switched Socket...........70
Aircon Point.....................11
Enclosure........................3
1 Lever Switch...................20
External Wall Mounted Light......6
Stove Isolator...................3
Single Switched Socket...........24
Weather Proof Plug...............7
[b]UnderFloorHeating................17[/b]

Link to comment
Share on other sites

Saving back to 2004, I don't have 2007 or 8

Using ACAD2004 it does not recognize the UnderFloorHeating blocks.

Are they dynamic blocks?

 

Using ACAD 2006 it does recognize them.

Link to comment
Share on other sites

Fixed the problem. Though I don't know what was wrong, or not exactly. Something with the blocks.

 

I created a test block named "test1".

 

The replaced all the "UnderfloorHeating"-blocks with "test1"

 

I noticed that all replaced except for four blocks... deleted those and inserted "UnderFloorHeating"-blocks again.

 

Now it counts all the blocks with QSELECT and the LISP.

Link to comment
Share on other sites

Yea, that lisp was written over 15 years ago. Yes, it is a dynamic block and 4 of them are some how different. The blockcount.lsp you ran shows *U10 as 17 and *U17 as 4, that equals 21. I ran another lsp that includes anonymous blocks and get *U17=0. :?

 

I will save the drawing as a 2000 and see what I come up with, I have never had this problem before. :?

Link to comment
Share on other sites

  • 3 years later...
  • 1 year later...

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...