Jump to content

help ...count texts with filter


leonucadomi

Recommended Posts

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 )

)

 

 

 

Link to comment
Share on other sites

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")))))
 

 

Link to comment
Share on other sites

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 by mhupp
notes
Link to comment
Share on other sites

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 by BIGAL
Link to comment
Share on other sites

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

 

 

 

 

 

Link to comment
Share on other sites

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)


 

  • Like 1
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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...