leonucadomi Posted August 10, 2021 Share Posted August 10, 2021 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 ) ) Quote Link to comment Share on other sites More sharing options...
leonucadomi Posted August 10, 2021 Author Share Posted August 10, 2021 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"))))) Quote Link to comment Share on other sites More sharing options...
mhupp Posted August 10, 2021 Share Posted August 10, 2021 A sample drawing would be a good start. 1 Quote Link to comment Share on other sites More sharing options...
leonucadomi Posted August 10, 2021 Author Share Posted August 10, 2021 example.dwg Quote Link to comment Share on other sites More sharing options...
leonucadomi Posted August 10, 2021 Author Share Posted August 10, 2021 26 minutes ago, mhupp said: A sample drawing would be a good start. here example friend Quote Link to comment Share on other sites More sharing options...
Jonathan Handojo Posted August 10, 2021 Share Posted August 10, 2021 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/ 1 1 Quote Link to comment Share on other sites More sharing options...
mhupp Posted August 11, 2021 Share Posted August 11, 2021 (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 August 11, 2021 by mhupp notes Quote Link to comment Share on other sites More sharing options...
BIGAL Posted August 11, 2021 Share Posted August 11, 2021 (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 August 11, 2021 by BIGAL Quote Link to comment Share on other sites More sharing options...
leonucadomi Posted August 11, 2021 Author Share Posted August 11, 2021 Excellent thanks Quote Link to comment Share on other sites More sharing options...
leonucadomi Posted August 11, 2021 Author Share Posted August 11, 2021 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted August 12, 2021 Share Posted August 12, 2021 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) 1 Quote Link to comment Share on other sites More sharing options...
leonucadomi Posted August 12, 2021 Author Share Posted August 12, 2021 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 Quote Link to comment Share on other sites More sharing options...
leonucadomi Posted August 12, 2021 Author Share Posted August 12, 2021 Thanks to your code I was able to extract the values as I need them, thank you very much Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.