help ...count texts with filter

[leonucadomi]

hello friends :

 

 

I want to make a selection in the window of texts , and I want to make a list of texts but grouping the texts that are repeated.  

 

 

can you help me?

 

 

(defun c:test (/ sset grupo)
  
(setq sset (ssget (list '(0 . "TEXT"))))
(setq grupo (sslength sset))
(princ "\nNumero de textos seleccionados ")
(princ grupo )

)

 

 

 

[leonucadomi]

If I have a list of values, how can I eliminate the repeated ones?  

and generate a new list...

 

(defun nqf (tuSS / i lista)
(setq cant (sslength tuSS))

;Pasar del SS a una lista de valores
   (setq i 0)
   (repeat (sslength tuSS)
      (setq lista (cons (cdr (assoc 1 (entget (ssname tuSS i)))) lista)
           i (1+ i))
   )

(PRINC lista)
(PRINC)

)

(defun c:PRU nil (nqf (ssget '((0 . "TEXT")))))
 

 

[mhupp]

A sample drawing would be a good start.

[leonucadomi]

example.dwg

[leonucadomi]

26 minutes ago, mhupp said:

A sample drawing would be a good start.

here example friend

[Jonathan Handojo]

Same topic as this, just a different dxf filter... use code 1 as opposed to code 2: https://www.cadtutor.net/forum/topic/73536-add-if-not-in-list/

[mhupp]

Shutout to @confutatis the code that makes the table was posted by him a few days ago. so if you need it to be bigger maybe he will pop in.

This asks you to Select text. it then makes a list with unique entities. it then goes through that list and makes a selects any text in the current tab and counts them.

then it makes a table or something with all the information.

 

(defun C:Textcount (/ SS txt txtlst lay laylst layer PT objtable i)
  (if (setq SS (ssget '((0 . "TEXT"))))
    (progn
      (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (if (not (vl-position (setq txt (cdr (assoc 1 (entget e)))) txtlst))
          (setq txtlst (cons txt txtlst))
        )
        (if (not (vl-position (setq lay (cdr (assoc 8 (entget e)))) laylst))
          (progn
            (setq laylst (cons lay laylst))
            (if (= layer nil)
              (setq layer lay)
              (setq layer (strcat Layer "," lay))
            )
          )
        )
      )
      (setq PT (getpoint "\nSelect point insertion table: ")
            objtable (vla-AddTable (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-Point PT) (+ 2 (length txtlst)) 2 6 30)
            i 0
      )
      (vla-SetText objtable i 0 "Text Count")
      (vla-SetCellTextHeight objtable i 0 2.40)
      (vla-SetCellAlignment objtable i 0 acMiddleCenter)
      (vla-SetText objtable (setq i (1+ i)) 0 "MARKER")
      (vla-SetCellTextHeight objtable i 0 2.10)
      (vla-SetCellAlignment objtable i 0 acMiddleCenter)
      (vla-SetText objtable i 1 "Counted")
      (vla-SetCellTextHeight objtable i 1 2.10)
      (vla-SetCellAlignment objtable i 1 acMiddleCenter)
      (foreach txt txtlst
        (if (setq SS (ssget "X" (list (cons 0 "TEXT") (cons 1 txt) (cons 410 (getvar 'ctab)) (cons 8 layer))))
          (progn
            (vla-SetText objtable (setq i (1+ i)) 0 txt)
            (vla-SetCellTextHeight objtable i 0 2.10)
            (vla-SetCellAlignment objtable i 0 acMiddleCenter)
            (vla-SetText objtable i 1 (itoa (sslength ss)))
            (vla-SetCellTextHeight objtable i 1 2.10)
            (vla-SetCellAlignment objtable i 1 acMiddleCenter)
          )
        )
      )
    )
  )
)

 

*edit

this only looks for text on the "COTAS" layer if this limits your selection delete "(cons 8 "COTAS")" out of the lisp

Updated the code to scrape the layer name from the selected text and only search on that layer for text.

Edited August 11, 2021 by mhupp
notes

[BIGAL]

Pretty sure I have some code from PBE that uses a mapcar function to to count the common items in a list, like ((x 1)(y 1)(x 1)(x 1)(y 1)) becomes ((x 3)(y 2) a easier way when making the table I use insert rows for the data as the list size can vary. I will try to find it. 

 

This is not it but something close.

 

; Make a count of common items 
; By AlanH Aug 2021

(defun my-count (a L)
  (cond
   ((null L) 0)
   ((equal a (car L)) (+ 1 (my-count a (cdr L))))
   (t (my-count a (cdr L))))
)

; By Gile
(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

(defun c:test ( / ss lst lt2 lst3 txt )

(setq ss (ssget (list (cons 0 "TEXT"))))
(if (= ss nil)
(alert "no text picked")
(progn
  (setq lst '() lst3 '())
  (repeat (setq x (sslength ss))
    (setq txt (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))))
    (setq lst (cons txt lst))
  )

  (setq lst2 (remove_doubles lst))
  (foreach val lst2
    (setq cnt (my-count val lst))
    (setq lst3 (cons (list val cnt) lst3))
  )

)
)

(princ "\n")
(princ lst3) ; do table now

(princ)
)
(c:test)

 

Edited August 11, 2021 by BIGAL

[leonucadomi]

Excellent thanks

[leonucadomi]

11 hours ago, BIGAL said:

Pretty sure I have some code from PBE that uses a mapcar function to to count the common items in a list, like ((x 1)(y 1)(x 1)(x 1)(y 1)) becomes ((x 3)(y 2) a easier way when making the table I use insert rows for the data as the list size can vary. I will try to find it. 

 

This is not it but something close.

 

; Make a count of common items 
; By AlanH Aug 2021

(defun my-count (a L)
  (cond
   ((null L) 0)
   ((equal a (car L)) (+ 1 (my-count a (cdr L))))
   (t (my-count a (cdr L))))
)

; By Gile
(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

(defun c:test ( / ss lst lt2 lst3 txt )

(setq ss (ssget (list (cons 0 "TEXT"))))
(if (= ss nil)
(alert "no text picked")
(progn
  (setq lst '() lst3 '())
  (repeat (setq x (sslength ss))
    (setq txt (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))))
    (setq lst (cons txt lst))
  )

  (setq lst2 (remove_doubles lst))
  (foreach val lst2
    (setq cnt (my-count val lst))
    (setq lst3 (cons (list val cnt) lst3))
  )

)
)

(princ "\n")
(princ lst3) ; do table now

(princ)
)
(c:test)

 

you can make each created data copy it to a specific text?

 

for example:

selected texts

L-6122-009

L-6122-008

L-6122-008

L-6122-008

 

list obtained   ((L-6122-009 1) (L-6122-008 3))

 

now this information can be transferred to existing texts

 

pick text1 ------>   L-6122-009

pick text2 ------>   1

pick text3 ------>   L-6122-008

pick text4 ------>   4

 

 

successively

 

 

 

 

 

[BIGAL]

YES 

 

But looking at your sample its better to make a table of the answer. Just select text then pick point for table. 

 

; https://www.cadtutor.net/forum/topic/73550-help-count-texts-with-filter/

; example of creating a table using passed variables
; By Alan H July 2017

; Make a count of common items 
; By AlanH Aug 2021 info@alanh.com.au

(defun my-count (a L)
  (cond
   ((null L) 0)
   ((equal a (car L)) (+ 1 (my-count a (cdr L))))
   (t (my-count a (cdr L))))
)

; By Gile
(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

(defun c:test ( / ss lst lt2 lst3 txt )

(setq ss (ssget (list (cons 0 "TEXT"))))
(if (= ss nil)
(alert "no text picked")
(progn
(setq lst '() lst3 '())
(repeat (setq x (sslength ss))
(setq txt (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))))
(setq lst (cons txt lst))
)

(setq lst2 (remove_doubles lst))
(setq howlong 0)
(foreach val lst2
    (setq cnt (my-count val lst))
    (setq lst3 (cons (list val cnt) lst3))
	(setq howlong (strlen (car (last lst3))))
	(if (> howlong howmany)(setq howmany howlong))
)

)
)

(setq txtht 45)

(setq numcolumns 2 numrows (+ 2 (length lst3)) txtsz (* txtht 2.0) colwidth (* howlong 2.0 txtht))
(setq sp (vlax-3d-point (getpoint "Pick top left")))
(setq doc  (vla-get-activedocument (vlax-get-acad-object) ))

(if (= (vla-get-activespace doc) 0)
(setq  curspc (vla-get-paperspace doc))
(setq curspc (vla-get-modelspace doc))
)

(setq rowheight (* 3.0 txtht))

(setq objtable (vla-addtable curspc sp numrows numcolumns rowheight colwidth))
(vla-setcolumnwidth objtable 1 (* 3 txtht))

(vla-SetTextHeight Objtable (+ acDataRow acTitleRow acHeaderRow) txtht)

(setq n 2)

(vla-setcolumnwidth objtable 0 colwidth)
(vla-setcolumnwidth objtable 1 400)

(vla-settext objtable 0 0 "TABLE title")
(vla-SetText Objtable 1 0 "Mark")
(vla-SetText Objtable 1 1 "Count")


(setq x 0)
(repeat (length lst3)
(setq val (nth (- n 2) lst3))
(vla-SetText Objtable n 0 (car val))
(vla-SetText Objtable n 1 (cadr val))
(setq n (1+ n))
)
(vla-SetAlignment objtable acDataRow acMiddleCenter)

(princ)
)

(c:test)

 

[leonucadomi]

3 hours ago, BIGAL said:

YES 

 

But looking at your sample its better to make a table of the answer. Just select text then pick point for table. 

 

; https://www.cadtutor.net/forum/topic/73550-help-count-texts-with-filter/

; example of creating a table using passed variables
; By Alan H July 2017

; Make a count of common items 
; By AlanH Aug 2021 info@alanh.com.au

(defun my-count (a L)
  (cond
   ((null L) 0)
   ((equal a (car L)) (+ 1 (my-count a (cdr L))))
   (t (my-count a (cdr L))))
)

; By Gile
(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

(defun c:test ( / ss lst lt2 lst3 txt )

(setq ss (ssget (list (cons 0 "TEXT"))))
(if (= ss nil)
(alert "no text picked")
(progn
(setq lst '() lst3 '())
(repeat (setq x (sslength ss))
(setq txt (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))))
(setq lst (cons txt lst))
)

(setq lst2 (remove_doubles lst))
(setq howlong 0)
(foreach val lst2
    (setq cnt (my-count val lst))
    (setq lst3 (cons (list val cnt) lst3))
	(setq howlong (strlen (car (last lst3))))
	(if (> howlong howmany)(setq howmany howlong))
)

)
)

(setq txtht 45)

(setq numcolumns 2 numrows (+ 2 (length lst3)) txtsz (* txtht 2.0) colwidth (* howlong 2.0 txtht))
(setq sp (vlax-3d-point (getpoint "Pick top left")))
(setq doc  (vla-get-activedocument (vlax-get-acad-object) ))

(if (= (vla-get-activespace doc) 0)
(setq  curspc (vla-get-paperspace doc))
(setq curspc (vla-get-modelspace doc))
)

(setq rowheight (* 3.0 txtht))

(setq objtable (vla-addtable curspc sp numrows numcolumns rowheight colwidth))
(vla-setcolumnwidth objtable 1 (* 3 txtht))

(vla-SetTextHeight Objtable (+ acDataRow acTitleRow acHeaderRow) txtht)

(setq n 2)

(vla-setcolumnwidth objtable 0 colwidth)
(vla-setcolumnwidth objtable 1 400)

(vla-settext objtable 0 0 "TABLE title")
(vla-SetText Objtable 1 0 "Mark")
(vla-SetText Objtable 1 1 "Count")


(setq x 0)
(repeat (length lst3)
(setq val (nth (- n 2) lst3))
(vla-SetText Objtable n 0 (car val))
(vla-SetText Objtable n 1 (cadr val))
(setq n (1+ n))
)
(vla-SetAlignment objtable acDataRow acMiddleCenter)

(princ)
)

(c:test)

 

I understand that a table is better, but I need to pass the information obtained in the list to some existing texts

[leonucadomi]

Thanks to your code I was able to extract the values as I need them, thank you very much