inventory by room with quantity

[sofiane]

Hello everyone.

 

So my request is quite simple, but I can't find any lisp that does it.

 

I have my plan, with 80 pieces. Each piece has blocks. I have already created groups, which represent each one of the pieces, with their block. 

 

My wish is very simple. I want a table, which generates for me, per room, the inventory of the blocks with their quantity. 

I have not found this at all, which seems strange to me anyway. 

 

Thanks to you.

 

Edited January 16, 2023 by sofiane

[Emmanuel Delay]

Yeah, that's not so hard.

 

Can you upload a dwg example, so we know what we're counting?

And how we know which block is in which room...

Edited January 16, 2023 by Emmanuel Delay

[sofiane]

Hi Emmanuel, Thanks for your answer. Here is the DWG as requested.

 

In the group there are only blocks.

 

 

example.dwg

Edited January 16, 2023 by sofiane

[pkenewell]

Try This: http://www.lee-mac.com/blockcounter.html

[sofiane]

I already use it, but I use it to know the number of blocks in the whole drawing.

 

My wish is:

1/ I select the whole drawing
2/ the lisp detects the groups

3/ it creates a table grouped by group.

 

Example :

Group 1:
* block A: 23
* block B: 12

 

Group 2:
* block A: 11

* block C : 43

etc ..

 

Edited January 16, 2023 by sofiane

[sofiane]

If I use lisp, I have the left array. What I want is to have the table on the right.

 

[Steven P]

I haven't looked at this really but how do you define a group of blocks and a room - looking at the example drawing the blocks are all near each other but there is no boundary to speak off to say "everything contained in this". It might be easier if it was. So assuming here that a group of blocks, a room are just blocks that are close to each other? Is there a maximum distance between blocks before they are in another room? Just wondering what the rule is to define a room

[sofiane]

No, my blocks are in a GROUP.

 

 

[sofiane]

On 1/16/2023 at 2:59 PM, Emmanuel Delay said:

Yeah, that's not so hard.

 

Can you upload a dwg example, so we know what we're counting?

And how we know which block is in which room...

 

any news?

[Steven P]

Hi Sofiane, I didn't get chance to think about this last night. Working with groups doesn't get asked so often here, which is why answers might be a bit slow.

 

How are you with LISP? What I am about to write might make perfect sense, might confuse you, but just putting some thoughts here to come back to later or as an idea for you

 

If you can select a group with LISP, below will make a selection set of the objects in that group (https://adndevblog.typepad.com/autocad/2012/12/how-to-add-a-group-in-a-selection-set-from-an-autolisp-function.html). If you have a selection set I think you can change or use Lee Macs code above and that SS to create the table.

 

Otherwise need to loop through the selection set and count through the blocks it contains.

 

Got to look for something to return the group name a selected object belongs to.

 

So this is from the link above

 

(defun selgrp (grpname)
   ;; grpname is the group name, it accepts
   ;; unnamed groupnames, such as *A1
   (setq grp (dictsearch (namedobjdict) "ACAD_GROUP"))
   (setq a1 (dictsearch (cdr (assoc -1 grp)) grpname))
   (setq ss (ssadd))
   (while (/= (assoc 340 a1) nil)
      (setq ent (assoc 340 a1))
      (setq ss (ssadd (cdr ent) ss))
      (setq a1 (subst (cons 0 "") ent a1))
   )
   ss
)

 

 

This looks like you select something and it returns the group name: (https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-group-name-of-an-entity/m-p/1526241/highlight/true#M201038)

 

Tested this one:

 

(defun c:ggn ( / grpnm )
  (setq grpnm (GGN (car (entsel))))
)

(defun GGN (obj / groups res)
(setq groups
(vla-get-groups
(vla-get-activedocument
(vlax-get-acad-object))))
(if (= (type obj) 'ENAME)
(setq obj (vlax-ename->vla-object obj))
)
(vlax-for x groups
(vlax-for item x
(if (equal obj item)
(setq res (cons (vlax-get x 'Name) res))
)
)
)
(reverse res)
)

 

 

 

 

So I reckon this will make a selection set of all the objects within a group of you click on an object in the group:

 

(setq ss (selgrp (cadr (GGN (car (entsel))))) )

 

 

 

Right that is google running white hot with all this searching. Next is to make a list of all the block types in the selection set returned above and make up a nice table

 

 

 

[Steven P]

and this one is it all put together, 

It doesn't make a table - should be easy enough to do that but though

 

Command is: lstgrpblks

See the last part for the next stages you might be able to do that?

 

;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-of-group-names-on-drawing/td-p/807566
(defun grp:list-groups ( / doc return)
  (setq doc (vla-get-activeDocument (vlax-get-acad-object)))
  (vlax-for group (vla-get-groups doc)
    (setq return (cons (vla-get-name group) return))
  ) ; end vlax-for
  (mapcar 'strcase (reverse return))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;https://adndevblog.typepad.com/autocad/2012/12/how-to-add-a-group-in-a-selection-set-from-an-autolisp-function.html
;;Lee Mac option
;;get all the items in a group
;;(defun selgrp (grpname / frp a1 ss ent)
(defun selgrp (grpname / frp a1 ss ent enttype)
;; grpname is the group name, it accepts unnamed groupnames, such as *A1
   (setq grp (dictsearch (namedobjdict) "ACAD_GROUP"))
   (setq a1 (dictsearch (cdr (assoc -1 grp)) grpname))
   (setq ss (ssadd))
   (while (/= (assoc 340 a1) nil)
      (setq ent (assoc 340 a1))
      (if (= (cdr (assoc 0 (entget (cdr ent)))) "INSERT") ; only blocks
        (progn
          (setq ss (ssadd (cdr ent) ss))
        ) ; end progn
        (progn
        ) ; end progn
      ) ; end if
      (setq a1 (subst (cons 0 "") ent a1))
   ) ; end while
   ss
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;https://www.cadtutor.net/forum/topic/55506-lisp-to-return-name-of-selected-blocks/
;;(defun c:simplecount ( / blk idx itm lst sel ) ;; Define function, declare local variables
(defun simplecount ( sel / blk idx itm lst ) ;; Define function, declare local variables
(setq SimpLspResult (list))
;;   (if ;; If the following expression returns a non-nil value
;;       (setq sel ;; Assign the value returned by the following expression to the symbol 'sel'
;;           (ssget ;; Prompt the user to make a selection and return the selection set if successful
;;              '((0 . "INSERT")) ;; Filter the selection to block references only (INSERTs)
;;           ) ;; end ssget
;;       ) ;; end setq
       (repeat ;; Repeat the enclosed expressions the following number of times:
           (setq idx ;; Assign the value returned by the following expression to the symbol 'idx'
               (sslength sel) ;; Return the number of items in the selection set
           ) ;; end setq
           (setq blk ;; Assign the block name to the variable 'blk'
               (cdr ;; Retrieve the value associated with DXF group 2 (the block name)
                   (assoc 2 ;; Retrieve the DXF group 2 dotted pair from the following DXF data
                       (entget ;; Retrieve the list of DXF data for the following entity
                         (ssname sel ;; Retrieve the entity at the following index
                             (setq idx (1- idx)) ;; Decrement the index variable (since selection set indexes are zero-based)
                         ) ;; end ssname
                       ) ;; end entget
                   ) ;; end assoc
               ) ;; end cdr
           ) ;; end setq
           ;; If the block is already recorded in the list:
           (if ;; If the following expression returns a non-nil value
               (setq itm ;; Assign the value returned by the following expression to the symbol 'itm'
                   (assoc blk lst) ;; Attempt to retrieve a list item whose first element is equal to the block name
               ) ;; end setq
               ;; Update the existing list entry:
               (setq lst ;; Redefine the 'lst' variable with the updated list data
                   (subst ;; Substitute the following list item in the list
                       (cons blk (1+ (cdr itm))) ;; Increment the number of occurrences recorded for this item in the list
                       itm ;; The existing item to be substituted
                       lst ;; The list in which to perform the substitution
                   ) ;; end subst
               ) ;; end setq
               ;; Else add a new entry to the list:
               (setq lst ;; Redefine the 'lst' variable with the following updated list data
                   (cons ;; 'Push' a new item onto the front of the list
                       (cons blk 1) ;; Construct a dotted pair whose first key is the block name and value is 1
                       lst ;; The list to which the item should be added (may be nil)
                   ) ;; end cons
               ) ;; end setq
           ) ;; end if
       ) ;; end repeat
       ;; Else the user didn't make a selection
;;   ) ;; end if
   ;; Print the results (if they exist)
   (foreach itm lst ;; For every 'itm' in the list given by 'lst'
;;       (princ ;; Print the following to the command-line
(setq SimpLspResult (append SimpLspResult (list
           (strcat ;; Concatenate the following strings
               "\n" ;; (New-line character)
               (car itm) ;; The block name
               ": " ;; An arbitrary separator for the data
               (itoa (cdr itm)) ;; The number of occurrences of the block, converted to a string
           ) ;; end strcat
))) ; end setq
;;       ) ;; end princ
   ) ;; end foreach
   (princ) ;; Suppress the return of the last evaluated expression (if)
SimpLspResult ; return result
) ;; end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:lstgrpblks ( / MyGroups acount GroupsSS blklst)
  (setq MyGroups ( grp:list-groups ) )
  (setq acount 0)
  (setq GroupsSS (list))
  (while (< acount (length MyGroups))
    (setq blklst (simplecount (selgrp (nth acount MyGroups)) ) )

(princ "\n")
(princ (nth acount MyGroups)) ;; Group Name
(princ "\n")
(princ blklst)
    ;; blklst: Block name : Ocurrance. Use LM string -> List to split up (del ':'),
    ;; append this list as MyGroup Block_name Occurances
    ;; get insert point for table
    ;; entmake table

    (setq acount (+ acount 1))
  ) ; end while
)

 

[sofiane]

Incredible Steven !!!!! Thanks a lot, I just tested it, it seems to work.

 

I get for each group, its name and the content with the quantities! I'll check all this manually once to see if there are any missing, but I think everything is ok! 

 

For the insertion in table unfortunately I do not know at all how to make.

[sofiane]

After a test phase, I just noticed that the groups that have an accent, are not counted. 

 

example : 
00_B_PREMONTAGE_EXT
nil

[Steven P]

Was that group in your example drawing? I only saw Room_1, Room_2 and Room_3 ? (I might have missed something)

[sofiane]

No I tried with another dwg which contained group names with accents. But that's ok, I'll change the group names to remove the accents.

[sofiane]

The only problem I have now is that I just tried it on a dwg with a lot of pieces. Except that my terminal history is limited and I can't see the first "print". The ideal is to have a table.

[Steven P]

Work is getting in the way at the moment, will try to make a table up shortly - should be copy and paste from something else I have

(copy and paste... might not be the tidiest code but it should work)

[Steven P]

Try this, the command is as before: lstgrpblks

 

Could be tidied up a bit more, but I think it works - for me - 

 

 

 

;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-of-group-names-on-drawing/td-p/807566
(defun grp:list-groups ( / doc return)
  (setq doc (vla-get-activeDocument (vlax-get-acad-object)))
  (vlax-for group (vla-get-groups doc)
    (setq return (cons (vla-get-name group) return))
  ) ; end vlax-for
  (mapcar 'strcase (reverse return))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;https://adndevblog.typepad.com/autocad/2012/12/how-to-add-a-group-in-a-selection-set-from-an-autolisp-function.html
;;Lee Mac option
;;get all the items in a group
;;(defun selgrp (grpname / frp a1 ss ent)
(defun selgrp (grpname / frp a1 ss ent enttype)
;; grpname is the group name, it accepts unnamed groupnames, such as *A1
   (setq grp (dictsearch (namedobjdict) "ACAD_GROUP"))
   (setq a1 (dictsearch (cdr (assoc -1 grp)) grpname))
   (setq ss (ssadd))
   (while (/= (assoc 340 a1) nil)
      (setq ent (assoc 340 a1))
      (if (= (cdr (assoc 0 (entget (cdr ent)))) "INSERT") ; only blocks
        (progn
          (setq ss (ssadd (cdr ent) ss))
        ) ; end progn
        (progn
        ) ; end progn
      ) ; end if
      (setq a1 (subst (cons 0 "") ent a1))
   ) ; end while
   ss
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;https://www.cadtutor.net/forum/topic/55506-lisp-to-return-name-of-selected-blocks/
;;(defun c:simplecount ( / blk idx itm lst sel ) ;; Define function, declare local variables
(defun simplecount ( MyGroup / blk idx itm lst ) ;; Define function, declare local variables
(setq sel (selgrp MyGroup) )

(setq SimpLspResult (list))
;;   (if ;; If the following expression returns a non-nil value
;;       (setq sel ;; Assign the value returned by the following expression to the symbol 'sel'
;;           (ssget ;; Prompt the user to make a selection and return the selection set if successful
;;              '((0 . "INSERT")) ;; Filter the selection to block references only (INSERTs)
;;           ) ;; end ssget
;;       ) ;; end setq
       (repeat ;; Repeat the enclosed expressions the following number of times:
           (setq idx ;; Assign the value returned by the following expression to the symbol 'idx'
               (sslength sel) ;; Return the number of items in the selection set
           ) ;; end setq
           (setq blk ;; Assign the block name to the variable 'blk'
               (cdr ;; Retrieve the value associated with DXF group 2 (the block name)
                   (assoc 2 ;; Retrieve the DXF group 2 dotted pair from the following DXF data
                       (entget ;; Retrieve the list of DXF data for the following entity
                         (ssname sel ;; Retrieve the entity at the following index
                             (setq idx (1- idx)) ;; Decrement the index variable (since selection set indexes are zero-based)
                         ) ;; end ssname
                       ) ;; end entget
                   ) ;; end assoc
               ) ;; end cdr
           ) ;; end setq
           ;; If the block is already recorded in the list:
           (if ;; If the following expression returns a non-nil value
               (setq itm ;; Assign the value returned by the following expression to the symbol 'itm'
                   (assoc blk lst) ;; Attempt to retrieve a list item whose first element is equal to the block name
               ) ;; end setq
               ;; Update the existing list entry:
               (setq lst ;; Redefine the 'lst' variable with the updated list data
                   (subst ;; Substitute the following list item in the list
                       (cons blk (1+ (cdr itm))) ;; Increment the number of occurrences recorded for this item in the list
                       itm ;; The existing item to be substituted
                       lst ;; The list in which to perform the substitution
                   ) ;; end subst
               ) ;; end setq
               ;; Else add a new entry to the list:
               (setq lst ;; Redefine the 'lst' variable with the following updated list data
                   (cons ;; 'Push' a new item onto the front of the list
                       (cons blk 1) ;; Construct a dotted pair whose first key is the block name and value is 1
                       lst ;; The list to which the item should be added (may be nil)
                   ) ;; end cons
               ) ;; end setq
           ) ;; end if
       ) ;; end repeat
       ;; Else the user didn't make a selection
;;   ) ;; end if
   ;; Print the results (if they exist)
   (foreach itm lst ;; For every 'itm' in the list given by 'lst'
;;       (princ ;; Print the following to the command-line

;(setq SimpLspResult (append SimpLspResult (list
;           (strcat ;; Concatenate the following strings
;               "\n" ;; (New-line character)
;               (car itm) ;; The block name
;               ": " ;; An arbitrary separator for the data
;               (itoa (cdr itm)) ;; The number of occurrences of the block, converted to a string
;           ) ;; end strcat
;))) ; end setq
;;       ) ;; end princ

    (setq SimpLspResult (append SimpLspResult (list MyGroup (car itm) (itoa (cdr itm)) )))

  ) ;; end foreach
  (princ) ;; Suppress the return of the last evaluated expression (if)
  SimpLspResult ; return result
) ;; end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun MakeTable ( blklst pt / fontht font acount)
  ;;Table Settings:
  (setq fontht 200)      ; Text Height
  (setq font "Standard") ; Font
  (setq BlkScale 10)     ; Block Scale
  (setq tablerowheight 1250)
;;Header:
  (MakeAngLine (offstpt pt 0  0   0) 9000 0)
  (MakeAngLine (offstpt pt 0 -500 0) 9000 0)
  (MakeAngLine (offstpt pt 0    0 0) (+ 500 (* ( / (length Blklst) 3) tablerowheight)) 270)
  (MakeAngLine (offstpt pt 2750 0 0) (+ 500 (* ( / (length Blklst) 3) tablerowheight)) 270)
  (MakeAngLine (offstpt pt 5000 0 0) (+ 500 (* ( / (length Blklst) 3) tablerowheight)) 270)
  (MakeAngLine (offstpt pt 7800 0 0) (+ 500 (* ( / (length Blklst) 3) tablerowheight)) 270)
  (MakeAngLine (offstpt pt 9000 0 0) (+ 500 (* ( / (length Blklst) 3) tablerowheight)) 270)
  (offsettxt "ROOM"       pt 200  -350 0 "ML" 200)
  (offsettxt "PREVIEW"    pt 2950 -350 0 "ML" 200)
  (offsettxt "BLOCK NAME" pt 5200 -350 0 "ML" 200)
  (offsettxt "COUNT"      pt 8000 -350 0 "ML" 200)
  (setq pt (offstpt pt 0 -500 0) ) ; bottom line of header
;;Rows:
  (setq acount 0)
  (while (< acount (length BlkLst))
    (setq pt (offstpt pt 0 (- tablerowheight) 0) )
    (offsettxt (nth (+ 0 acount) BlkLst)          pt 200  500 0 "ML" 200)
    (insblk    (nth (+ 1 acount) BlkLst) (offstpt pt 3500 300 0) 10 )
    (offsettxt (nth (+ 1 acount) BlkLst)          pt 5200 500 0 "ML" 200)
    (offsettxt (nth (+ 2 acount) BlkLst)          pt 8000 500 0 "ML" 200)
    (MakeAngLine pt 9000 0)
    (setq acount (+ acount 3))
  ) ; end while
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Make Entities
  (defun insblk ( BlkNm Pt Sc / ) ; Insert evenly scaled block, 0 rotation
    (entmake
	 (list
	   (cons 0 "INSERT")
;	   (cons 8 Layer)
	   (cons 8 "0")
	   (cons 2 BlkNm)
	   (cons 10 Pt)
	   (cons 41 0.5)
	   (cons 42 0.5)
	   (cons 43 0.5)
	   (cons 50 0) ; rotation
         )
    )
  )
  (defun MakeText (MyString cons10 Just Ht / MyText )
    (entmakex (append (list (cons 0 "TEXT")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbText")
                            (cons 10 cons10)
                            (cons 40 Ht)
                            (cons 1 MyString)
              ))
    )
    (command "_.justifytext" (entlast) "" Just) ;;Justifications l c r tl tc tr mnl mc mr bl bc br
  )
  (defun offsettxt (txt Pt X Y Z Just Ht / )
    (MakeText txt (mapcar '+ Pt (list X Y Z) ) Just Ht)
  )
  (defun MakeMText (MyString cons10 Just Width Ht)
    (entmakex (list (cons 0 "MTEXT")         
                    (cons 100 "AcDbEntity")
                    (cons 100 "AcDbMText")
                    (cons 10 cons10)
                    (cons 40 Ht)
                    (cons 41 Width)
                    (cons 1 MyString)
    ))
    (command "_.justifytext" (entlast) "" Just) ;;Justifications l c r tl tc tr mnl mc mr bl bc br
  )
  (defun MakeLWPoly ( lst cls / MyLWPoly )
    (entmakex (append (list (cons 0 "LWPOLYLINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbPolyline")
                            (cons 90 (length lst))
                            (cons 70 cls))
                    (mapcar (function (lambda (p) (cons 10 p))) lst))
    )
  )
  (defun MakeCircle ( lst rad MyLay / MyCircle )
    (entmakex (append (list (cons 0 "CIRCLE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbCircle")
                            (cons 8 MyLay)
                            (cons 62 253)
                            (cons 10 lst)
                            (cons 40 rad)
              ))
    )
  )
  (defun MakeLine ( con10 con11 /  )
    (entmakex (append (list (cons 0 "LINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbLine")
                            (cons 10 con10)
                            (cons 11 con11)
              ))
    )
  )
  (defun MakeAngLine ( con10 dist ang / MyLine )
    (defun DTR ( deg / ) (* pi (/ (float deg) 180.0)) )
    (setq X (* (cos (DTR ang)) dist))
    (setq Y (* (sin (DTR ang)) dist))
    (setq Z 0)
    (setq con11 (offstpt con10 X Y Z))
    (MakeLine con10 con11)
  )
  (defun offstpt ( Pt X Y Z / MyPt ) ;;offset a point
    (setq MyPt (mapcar '+ Pt (list X Y Z)))
    Mypt
  )
  (defun MakePoint ( pt / )
    (entmakex (append (list (cons 0 "POINT")
                      (cons 10 pt)
              ))
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:lstgrpblks ( / MyGroups acount GroupsSS blklst pt)
  (setq MyGroups ( grp:list-groups ) )
  (setq acount 0)
  (setq GroupsSS (list))
  (setq pt nil)
  (setq pt (getpoint "Select tables Insertion Point"))

  (while (< acount (length MyGroups))
    (setq blklst (simplecount (nth acount MyGroups)) )
    (if (= acount 0)
      ()
      (setq pt (mapcar '+ (list 12500 0 0) pt))
    ) 
    (MakeTable blklst pt)
    (setq acount (+ acount 1))
  ) ; end while
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

[sofiane]

Thanks a lot. It worked, but there are 2 problems.

 

The first one is that instead of generating a single table, it generates one per group. So I have 80 pieces in my DWG and I end up with 80 tables haha. The idea is to concatenate them one below the other and me afterwards.

 

The second one is that it's not really a table that he generated for me. It's polylines, mtext etc ... So I can't extract the table in csv.

[Steven P]

both are quite easy to fix.. it's all there (nearly... with a little bit more help from the internet)

 

This change should make a single table (made up the table 'old style' to give more control on it's appearance - for example row height to hold the blocks.. and I don't do a lot with 'proper' tables), and save the table as a CSV file (far easier I reckon to do it in 1 process?)

 

As a bit extra, just copies everything to clipboard - as a single line of text separated by commas, just because I can

 

 

;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-of-group-names-on-drawing/td-p/807566
(defun grp:list-groups ( / doc return)
  (setq doc (vla-get-activeDocument (vlax-get-acad-object)))
  (vlax-for group (vla-get-groups doc)
    (setq return (cons (vla-get-name group) return))
  ) ; end vlax-for
  (mapcar 'strcase (reverse return))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;https://adndevblog.typepad.com/autocad/2012/12/how-to-add-a-group-in-a-selection-set-from-an-autolisp-function.html
;;Lee Mac option
;;get all the items in a group
;;(defun selgrp (grpname / frp a1 ss ent)
(defun selgrp (grpname / frp a1 ss ent enttype)
;; grpname is the group name, it accepts unnamed groupnames, such as *A1
   (setq grp (dictsearch (namedobjdict) "ACAD_GROUP"))
   (setq a1 (dictsearch (cdr (assoc -1 grp)) grpname))
   (setq ss (ssadd))
   (while (/= (assoc 340 a1) nil)
      (setq ent (assoc 340 a1))
      (if (= (cdr (assoc 0 (entget (cdr ent)))) "INSERT") ; only blocks
        (progn
          (setq ss (ssadd (cdr ent) ss))
        ) ; end progn
        (progn
        ) ; end progn
      ) ; end if
      (setq a1 (subst (cons 0 "") ent a1))
   ) ; end while
   ss
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;https://www.cadtutor.net/forum/topic/55506-lisp-to-return-name-of-selected-blocks/
;;(defun c:simplecount ( / blk idx itm lst sel ) ;; Define function, declare local variables
(defun simplecount ( MyGroup / blk idx itm lst ) ;; Define function, declare local variables
(setq sel (selgrp MyGroup) )

(setq SimpLspResult (list))
;;   (if ;; If the following expression returns a non-nil value
;;       (setq sel ;; Assign the value returned by the following expression to the symbol 'sel'
;;           (ssget ;; Prompt the user to make a selection and return the selection set if successful
;;              '((0 . "INSERT")) ;; Filter the selection to block references only (INSERTs)
;;           ) ;; end ssget
;;       ) ;; end setq
       (repeat ;; Repeat the enclosed expressions the following number of times:
           (setq idx ;; Assign the value returned by the following expression to the symbol 'idx'
               (sslength sel) ;; Return the number of items in the selection set
           ) ;; end setq
           (setq blk ;; Assign the block name to the variable 'blk'
               (cdr ;; Retrieve the value associated with DXF group 2 (the block name)
                   (assoc 2 ;; Retrieve the DXF group 2 dotted pair from the following DXF data
                       (entget ;; Retrieve the list of DXF data for the following entity
                         (ssname sel ;; Retrieve the entity at the following index
                             (setq idx (1- idx)) ;; Decrement the index variable (since selection set indexes are zero-based)
                         ) ;; end ssname
                       ) ;; end entget
                   ) ;; end assoc
               ) ;; end cdr
           ) ;; end setq
           ;; If the block is already recorded in the list:
           (if ;; If the following expression returns a non-nil value
               (setq itm ;; Assign the value returned by the following expression to the symbol 'itm'
                   (assoc blk lst) ;; Attempt to retrieve a list item whose first element is equal to the block name
               ) ;; end setq
               ;; Update the existing list entry:
               (setq lst ;; Redefine the 'lst' variable with the updated list data
                   (subst ;; Substitute the following list item in the list
                       (cons blk (1+ (cdr itm))) ;; Increment the number of occurrences recorded for this item in the list
                       itm ;; The existing item to be substituted
                       lst ;; The list in which to perform the substitution
                   ) ;; end subst
               ) ;; end setq
               ;; Else add a new entry to the list:
               (setq lst ;; Redefine the 'lst' variable with the following updated list data
                   (cons ;; 'Push' a new item onto the front of the list
                       (cons blk 1) ;; Construct a dotted pair whose first key is the block name and value is 1
                       lst ;; The list to which the item should be added (may be nil)
                   ) ;; end cons
               ) ;; end setq
           ) ;; end if
       ) ;; end repeat
       ;; Else the user didn't make a selection
;;   ) ;; end if
   ;; Print the results (if they exist)
   (foreach itm lst ;; For every 'itm' in the list given by 'lst'
;;       (princ ;; Print the following to the command-line

;(setq SimpLspResult (append SimpLspResult (list
;           (strcat ;; Concatenate the following strings
;               "\n" ;; (New-line character)
;               (car itm) ;; The block name
;               ": " ;; An arbitrary separator for the data
;               (itoa (cdr itm)) ;; The number of occurrences of the block, converted to a string
;           ) ;; end strcat
;))) ; end setq
;;       ) ;; end princ

    (setq SimpLspResult (append SimpLspResult (list MyGroup (car itm) (itoa (cdr itm)) )))

  ) ;; end foreach
  (princ) ;; Suppress the return of the last evaluated expression (if)
  SimpLspResult ; return result
) ;; end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun MakeTable ( blklst pt / fontht font acount)
  ;;Table Settings:
  (setq fontht 200)      ; Text Height
  (setq font "Standard") ; Font
  (setq BlkScale 10)     ; Block Scale
  (setq tablerowheight 1250)
;;Header:
  (MakeAngLine (offstpt pt 0  0   0) 9000 0)
  (MakeAngLine (offstpt pt 0 -500 0) 9000 0)
  (MakeAngLine (offstpt pt 0    0 0) (+ 500 (* ( / (length Blklst) 3) tablerowheight)) 270)
  (MakeAngLine (offstpt pt 2750 0 0) (+ 500 (* ( / (length Blklst) 3) tablerowheight)) 270)
  (MakeAngLine (offstpt pt 5000 0 0) (+ 500 (* ( / (length Blklst) 3) tablerowheight)) 270)
  (MakeAngLine (offstpt pt 7800 0 0) (+ 500 (* ( / (length Blklst) 3) tablerowheight)) 270)
  (MakeAngLine (offstpt pt 9000 0 0) (+ 500 (* ( / (length Blklst) 3) tablerowheight)) 270)
  (offsettxt "ROOM"       pt 200  -350 0 "ML" 200)
  (offsettxt "PREVIEW"    pt 2950 -350 0 "ML" 200)
  (offsettxt "BLOCK NAME" pt 5200 -350 0 "ML" 200)
  (offsettxt "COUNT"      pt 8000 -350 0 "ML" 200)
  (setq pt (offstpt pt 0 -500 0) ) ; bottom line of header
;;Rows:
  (setq acount 0)
  (while (< acount (length BlkLst))
    (setq pt (offstpt pt 0 (- tablerowheight) 0) )
    (offsettxt (nth (+ 0 acount) BlkLst)          pt 200  500 0 "ML" 200)
    (insblk    (nth (+ 1 acount) BlkLst) (offstpt pt 3500 300 0) BlkScale )
    (offsettxt (nth (+ 1 acount) BlkLst)          pt 5200 500 0 "ML" 200)
    (offsettxt (nth (+ 2 acount) BlkLst)          pt 8000 500 0 "ML" 200)
    (MakeAngLine pt 9000 0)
    (setq acount (+ acount 3))
  ) ; end while
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Make Entities
  (defun insblk ( BlkNm Pt Sc / ) ; Insert evenly scaled block, 0 rotation
    (entmake
	 (list
	   (cons 0 "INSERT")
;	   (cons 8 Layer)
	   (cons 8 "0")
	   (cons 2 BlkNm)
	   (cons 10 Pt)
	   (cons 41 (/ BlkScale 20))
	   (cons 42 (/ BlkScale 20))
	   (cons 43 (/ BlkScale 20))
	   (cons 50 0) ; rotation
         )
    )
  )
  (defun MakeText (MyString cons10 Just Ht / MyText )
    (entmakex (append (list (cons 0 "TEXT")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbText")
                            (cons 10 cons10)
                            (cons 40 Ht)
                            (cons 1 MyString)
              ))
    )
    (command "_.justifytext" (entlast) "" Just) ;;Justifications l c r tl tc tr mnl mc mr bl bc br
  )
  (defun offsettxt (txt Pt X Y Z Just Ht / )
    (MakeText txt (mapcar '+ Pt (list X Y Z) ) Just Ht)
  )
  (defun MakeMText (MyString cons10 Just Width Ht)
    (entmakex (list (cons 0 "MTEXT")         
                    (cons 100 "AcDbEntity")
                    (cons 100 "AcDbMText")
                    (cons 10 cons10)
                    (cons 40 Ht)
                    (cons 41 Width)
                    (cons 1 MyString)
    ))
    (command "_.justifytext" (entlast) "" Just) ;;Justifications l c r tl tc tr mnl mc mr bl bc br
  )
  (defun MakeLWPoly ( lst cls / MyLWPoly )
    (entmakex (append (list (cons 0 "LWPOLYLINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbPolyline")
                            (cons 90 (length lst))
                            (cons 70 cls))
                    (mapcar (function (lambda (p) (cons 10 p))) lst))
    )
  )
  (defun MakeCircle ( lst rad MyLay / MyCircle )
    (entmakex (append (list (cons 0 "CIRCLE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbCircle")
                            (cons 8 MyLay)
                            (cons 62 253)
                            (cons 10 lst)
                            (cons 40 rad)
              ))
    )
  )
  (defun MakeLine ( con10 con11 /  )
    (entmakex (append (list (cons 0 "LINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbLine")
                            (cons 10 con10)
                            (cons 11 con11)
              ))
    )
  )
  (defun MakeAngLine ( con10 dist ang / MyLine )
    (defun DTR ( deg / ) (* pi (/ (float deg) 180.0)) )
    (setq X (* (cos (DTR ang)) dist))
    (setq Y (* (sin (DTR ang)) dist))
    (setq Z 0)
    (setq con11 (offstpt con10 X Y Z))
    (MakeLine con10 con11)
  )
  (defun offstpt ( Pt X Y Z / MyPt ) ;;offset a point
    (setq MyPt (mapcar '+ Pt (list X Y Z)))
    Mypt
  )
  (defun MakePoint ( pt / )
    (entmakex (append (list (cons 0 "POINT")
                      (cons 10 pt)
              ))
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun SetClipBoardText ( MyText / htmlfile result )
  (vlax-invoke (vlax-get (vlax-get (setq htmlfile (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "Text" Mytext)
  (vlax-release-object htmlfile)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:lst->str ( lst del )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:csv-addquotes ( str sep / pos )
    (cond
        (   (wcmatch str (strcat "*[`" sep "\"]*"))
            (setq pos 0)    
            (while (setq pos (vl-string-position 34 str pos))
                (setq str (vl-string-subst "\"\"" "\"" str pos)
                      pos (+ pos 2)
                )
            )
            (strcat "\"" str "\"")
        )
        (   str   )
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/split-a-list-in-parts/td-p/1923656
(defun split-list (lst n)
  (if lst
    (cons (sublst lst 1 n)
      (split-list (sublst lst (1+ n) nil) n)
    )
  )
)
;; http://www.lee-mac.com/writecsv.html
;; Write CSV  -  Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - [lst] list of lists, sublist is row of cell values
;; csv - [str] filename of CSV file to write
;; Returns T if successful, else nil
(defun LM:writecsv ( lst csv / des sep )
    (if (setq des (open csv "w"))
        (progn
            (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
            (foreach row lst (write-line (LM:lst->csv row sep) des))
            (close des)
            t
        )
    )
)
;; List -> CSV  -  Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token
(defun LM:lst->csv ( lst sep )
    (if (cdr lst)
        (strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
        (LM:csv-addquotes (car lst) sep)
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:lstgrpblks ( / MyGroups acount GroupsSS blklst blktxt blkdetaillst pt)
  (setq MyGroups ( grp:list-groups ) )
  (setq GroupsSS (list))
  (setq pt nil)
  (setq pt (getpoint "Select tables Insertion Point"))
  (setq blklst (list))

  (setq acount 0)
  (while (< acount (length MyGroups))
    (setq blklst (append blklst (simplecount (nth acount MyGroups))) )
    (setq acount (+ acount 1))
  ) ; end while
  (MakeTable blklst pt)
  (setq blkdetaillst (split-list blklst 3) )
  (setq fn (getfiled "Create Output File" "" "csv" 1))
  (LM:writecsv blkdetaillst fn)

  (SetClipBoardText (setq blktxt (LM:lst->str blklst ", ")) )
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

Edited January 20, 2023 by Steven P
Just changed the code slightly