Counting multiple text contents

Hi folks, anybody can help me, i have received furniture layout from outside. Now my boss want me to create a table for all the furnitures. For example i have executive desks, meeting tables, chairs etc. All the executive desks tags with ed, meeting tables tags with mt and chairs tags with ch. I want to count all the tags and put in the table, the tags are only text. Any lisp can provide or technique? i have multiple floor to do the same. Thanks in advance...

Try Dataextraction (may be Eattext in 2007)

The tags are text and not attributes, right?

Perhaps you'll find a solution within this thread:

http://www.cadtutor.net/forum/showthread.php?t=4522

EATTEXT works but you'll get a lot of info that isn't relavent or useful. And you have to pay attention to what AutoCAD is asking. I'm not impressed with this method for extracting plain text.

This should get you started...

(defun _TextCount (ss / lst)
 ;; Alan J. Thompson, 06.28.10
 (if (eq (type ss) 'PICKSET)
   (vl-sort ((lambda (i / str ass)
               (while (setq e (ssname ss (setq i (1+ i))))
                 (if (setq str (cdr (assoc 1 (entget e))))
                   (if (setq ass (assoc str lst))
                     (setq lst (subst (cons str (1+ (cdr ass))) ass lst))
                     (setq lst (cons (cons str 1) lst))
                   )
                 )
               )
               lst
             )
              -1
            )
            (function (lambda (a b) (< (car a) (car b))))
   )
 )
)

eg.

(_TextCount (ssget '((0 . "MTEXT,TEXT"))))

This should get you started...

(defun _TextCount (ss / lst)
 ;; Alan J. Thompson, 06.28.10
 (if (eq (type ss) 'PICKSET)
   (vl-sort ((lambda (i / str ass)
               (while (setq e (ssname ss (setq i (1+ i))))
                 (if (setq str (cdr (assoc 1 (entget e))))
                   (if (setq ass (assoc str lst))
                     (setq lst (subst (cons str (1+ (cdr ass))) ass lst))
                     (setq lst (cons (cons str 1) lst))
                   )
                 )
               )
               lst
             )
              -1
            )
            (function (lambda (a b) (< (car a) (car b))))
   )
 )
)

 

eg.

(_TextCount (ssget '((0 . "MTEXT,TEXT"))))

Too quickly

...want to count all the tags and put in the table

Regards,

~'J'~

Too quickly

 

 

Regards,

 

~'J'~

This should get you started...

No free lunch. I'm not going to do everything.

No free lunch. I'm not going to do everything.

Agreed,

It's not so difficult, but it is needs a lot of time

~'J'~

Agreed,

 

It's not so difficult, but it is needs a lot of time

 

~'J'~

Hi folks, anybody can help me, i have received furniture layout from outside. Now my boss want me to create a table for all the furnitures. For example i have executive desks, meeting tables, chairs etc. All the executive desks tags with ed, meeting tables tags with mt and chairs tags with ch. I want to count all the tags and put in the table, the tags are only text. Any lisp can provide or technique? i have multiple floor to do the same. Thanks in advance...

Try this out

This routine will allow you to store data in .csv file

Or you want to draw acad table instead?

(vl-load-com)
(defun dxf (key alist)
 (cdr (assoc key alist))
 )
;; based on function from [url]http://www.cadtutor.net/forum/showthread.php?t=7230[/url]
(defun count_occurs (lst fuzz)
 (if (car lst)
   (cons (cons (car lst)
 (length (vl-remove-if-not
    (function (lambda (x)
      (if (not fuzz)(eq x (car lst))   (equal x (car lst) fuzz))))
    lst))
 )
  (count_occurs
    (vl-remove-if
      (function (lambda (x)
    (if (not fuzz)(eq x (car lst))   (equal x (car lst) fuzz))))
      lst)
    fuzz
    )
  )
   )
 )
;;==============================================;;
(defun C:FURN (/ *error* datafile data_line data_list elist entlist filename table_list)
 (defun *error* (msg)
   (if datafile (close datafile))
   (if msg (princ (strcat "\nError! " msg)))
   (princ)
   )

(setq filename (strcat (getvar "dwgprefix")
       (vl-filename-base (getvar "dwgname"))".csv")
)

 (if
      (setq entlist (vl-remove-if
    'listp
    (mapcar 'cadr (ssnamex
      (ssget (list
        (cons 0 "TEXT")
        (cons 1 "mt,ed,ch,mt.,ed.,ch.")))))));<-- change texts here
    (progn   
  (foreach en  entlist
    (setq elist (entget en))
    (setq data_list (cons (dxf 1 elist)data_list))
    )
   (setq table_list (count_occurs data_list nil))
   (setq datafile (open filename "W"))
      (setq data_line "Item,Quantity")
       (write-line data_line datafile)
      (foreach subtotal table_list
 (write-line (strcat (car subtotal)"," (itoa (cdr subtotal))) datafile)
 )      
      (close datafile)
(alert (strcat "File saved as " filename))
      )
    )
 (princ)
 )      
(prompt "\nStart command with FURN")
(prin1)

Here is another one this will draw acad table

(vl-load-com)
(defun dxf (key alist)
 (cdr (assoc key alist))
 )
;; based on function from [url]http://www.cadtutor.net/forum/showthread.php?t=7230[/url]
(defun count_occurs (lst fuzz)
 (if (car lst)
   (cons (cons (car lst)
 (length (vl-remove-if-not
    (function (lambda (x)
      (if (not fuzz)(eq x (car lst))   (equal x (car lst) fuzz))))
    lst))
 )
  (count_occurs
    (vl-remove-if
      (function (lambda (x)
    (if (not fuzz)(eq x (car lst))   (equal x (car lst) fuzz))))
      lst)
    fuzz
    )
  )
   )
 )
;;==============================================;;
(defun C:FU (/ *error*  acsp adoc atable cnt col
       datafile data_list elist entlist headers
       ip row table_list textheight)
 ;;//
 (defun fill_cell (atable row column text textheight align)
 (vla-settext  atable row column text)
 (vla-setcelltextheight atable row column textheight)  
 (vla-setcellalignment atable row column align)
 )
 ;;//
 (defun *error* (msg /)
   (if msg
   (if (not (member msg '("Function cancelled" "quit / exit abort")))
     (princ (strcat "\nError! ERRNO = " (itoa (getvar "errno")) ". " msg))
   )
     )
   (vla-endundomark
     (vla-get-activedocument
    (vlax-get-acad-object))
     )
   (princ)
 )


 (if
      (setq entlist (vl-remove-if
    'listp
    (mapcar 'cadr (ssnamex
      (ssget (list
        (cons 0 "TEXT")
        (cons 1 "mt,ed,ch,mt.,ed.,ch.")))))))
    (progn
(vla-startundomark
     (vla-get-activedocument
    (vlax-get-acad-object))
     )

      (setq textheight (dxf 40 (entget (car entlist))))
  (foreach en  entlist
    (setq elist (entget en))
    (setq data_list (cons (dxf 1 elist)data_list))
    )
   (setq table_list (count_occurs data_list nil))
   (setq table_list
      (vl-sort table_list
 (function (lambda(a b)
  (< (car a)(car b))))
      )
    )
(setq ip (getpoint
     "\nUpper left poin of the table: \n"))
   (setq headers '("Item" "QTY")
)
      (setq acsp (vla-get-block (vla-get-activelayout
      (vla-get-activedocument
        (vlax-get-acad-object)))))
 (setq atable (vlax-invoke
  acsp
  'Addtable
  ip
  (+ 2 (length table_list))
  (length headers)
  (* textheight 1.
  (* textheight 12)
  )
)
 (vla-put-regeneratetablesuppressed atable :vlax-true)
 (vla-put-height atable (* (+ 2 (length table_list))(* textheight 2)))
 (vla-put-horzcellmargin atable (* textheight 0.5))
 (vla-put-vertcellmargin atable (* textheight 0.1))
 (vla-setcolumnwidth atable 0 (* textheight 6))
 (foreach c  '(0 1)
   (vla-setcolumnwidth atable c (* textheight 12))
   )
 (vla-settextstyle atable 1 "Standard")
 (vla-settextstyle atable 2 "Standard")
 (vla-settextstyle atable 4 "Standard")
 (vla-settextheight atable actitlerow (* textheight 1.5))
 (vla-settextheight atable acheaderrow (* textheight 1.25))
 (vla-settextheight atable acdatarow textheight)
 (vla-setgridvisibility atable achorzinside acdatarow :vlax-true)
 (fill_cell atable 0 0 "FURNITURE" (* textheight 1.5) 5)

 (setq col 0
row 1
)
 (foreach a  headers
   (fill_cell atable row col a (* textheight 1.25) 4)
   (setq col (1+ col))
   )
 (setq cnt 1
row 2)
 (foreach p  table_list
   (setq col 0)
  (fill_cell atable row col (car p) textheight 4)
     (setq col (1+ col))
  (fill_cell atable row col (itoa (cdr p)) textheight 4)
   (setq row (1+ row)
  cnt (1+ cnt)
  )
   )
 (vla-put-regeneratetablesuppressed atable :vlax-false)
 (vlax-release-object atable)

      )
    )
 (princ)
 )      
(prompt "\nStart command with FU")
(prin1)

~'J'~