Jump to content

help ...count texts with filter

leonucadomi

By leonucadomi
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

leonucadomi Rising Star

leonucadomi

Posted
Posted

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 Rising Star

leonucadomi

Posted
  • Author
Posted

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 Grand Master

mhupp

Posted
Posted

A sample drawing would be a good start.

  • Like 1
leonucadomi Rising Star

leonucadomi

Posted
  • Author
Posted
26 minutes ago, mhupp said:

A sample drawing would be a good start.

here example friend

mhupp Grand Master

mhupp

Posted
Posted (edited)

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
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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
leonucadomi Rising Star

leonucadomi

Posted
  • Author
Posted
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 Grand Master

BIGAL

Posted
Posted

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
leonucadomi Rising Star

leonucadomi

Posted
  • Author
Posted
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 Rising Star

leonucadomi

Posted
  • Author
Posted

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

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.

×
 Share
Go to topic listing
×
×
  • Create New...