« previous next »
Pages: 1 [2]  All |   Go Down

Author Topic: hepl : Search duplicate text, change color  (Read 4667 times)

0 Members and 1 Guest are viewing this topic.

mhy3sx

  • Newt
  • Posts: 129
Re: hepl : Search duplicate text, change color
« Reply #15 on: September 28, 2023, 10:57:51 AM »
I try this

Code - Auto/Visual Lisp: [Select]
  1. (defun C:TFD (/ *error* doc mss n tc tclist duplist tcss); = Text [& Mtext] Find Duplicates
  2.       (defun *error* (errmsg)
  3.         (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
  4.           (princ (strcat "\nError: " errmsg))
  5.         ); if
  6.         (setvar cmdecho 1)
  7.         (vla-endundomark doc)
  8.         (princ)
  9.       ); defun - *error*
  11.     ;;;     (if (setq mss (ssget "_X" (list '(0 . "*TEXT") '(8 . "PST")(cons 410 (getvar 'ctab)))))
  12.         (if (setq mss  (ssget "_X" '((0 . "*TEXT") (8 . "PST") (1 . "#####[~.][~.]#####") (cons 410 (getvar 'ctab)))))
  13.          (progn ; then
  14.           (setvar 'cmdecho 0)
  15.           (setq TFDss (ssadd)); initially empty duplicates selection set
  16.           (repeat (setq n (sslength mss))
  17.             (setq tc (cdr (assoc 1 (entget (ssname mss (setq n (1- n)))))))
  18.               ; = text content of each
  19.             (cond
  20.               ((member tc duplist))
  21.                 ; = already in duplicates list [do nothing]
  22.               ((member tc tclist) (setq duplist (cons tc duplist)))
  23.                 ; = already in content list [put in duplicates list]
  24.               ((setq tclist (cons tc tclist)))
  25.                 ; = first instance of it [put in content list]
  26.             ); cond
  27.           ); repeat
  28.  
  29.          
  30.           (setq col 0); base value for counting color numbers upward
  31.          
  32.           (foreach tc duplist ; assign colors to sets of duplicates
  33.     ;;;     (setq tcss (ssget "_X" (list '(0 . "*TEXT")'(8 . "PST") (cons 1 tc))))      
  34.             (setq tcss (ssget "_X" '((0 . "*TEXT") (8 . "PST") (1 . "#####[~.][~.]#####") (cons 1 tc))))
  35.     ;;;     (command "_.layer" "_make" "Text" "_color" 7 "" "")
  36.     ;;;     (command "_.chprop" tcss "" "_color" (setq col (1+ col)) "")
  37.     ;;;     (command "_.chprop"  tcss "" "_layer" "Text" "")
  38.             (command "_.chprop" tcss "" "_color" 230 "")
  39.             (repeat (setq n (sslength tcss)) (ssadd (ssname tcss (setq n (1- n))) TFDss))
  40.               ; put in collective duplicates selection set
  41.           ); foreach
  42.           (setvar 'cmdecho 1)
  43.           (if (> (sslength TFDss) 0)
  44.             (sssetfirst nil TFDss); select/grip/highlight
  45.             (prompt "\nNo Text/Mtext objects with duplicate text content found."); else
  46.           ); if
  47.         ); progn
  48.       ); if
  49.       (vla-endundomark doc)
  50.       (princ)
  51.     ); end defun
  52.    
  53.  
  54.  


and gives me this error

Code: [Select]
Error: bad SSGET listbad argument type: (or stringp symbolp): nil
CAn any one fix it ?

Thanks
Logged

danAllen

  • Newt
  • Posts: 134
Re: hepl : Search duplicate text, change color
« Reply #16 on: September 28, 2023, 11:04:31 AM »
Change the quote ' symbols to list. Quotes won't allow you to use cons with a variable
Logged

mhy3sx

  • Newt
  • Posts: 129
Re: hepl : Search duplicate text, change color
« Reply #17 on: September 28, 2023, 03:49:27 PM »
I did the change

Code - Auto/Visual Lisp: [Select]
  1.     (defun C:TFD (/ *error* doc mss n tc tclist duplist tcss); = Text [& Mtext] Find Duplicates
  2.           (defun *error* (errmsg)
  3.             (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
  4.               (princ (strcat "\nError: " errmsg))
  5.             ); if
  6.             (setvar cmdecho 1)
  7.             (vla-endundomark doc)
  8.             (princ)
  9.           ); defun - *error*
  11.         ;;;     (if (setq mss (ssget "_X" (list '(0 . "*TEXT") '(8 . "PST")(cons 410 (getvar 'ctab)))))
  12.             (if (setq mss  (ssget "_X" (list (0 . "*TEXT") (8 . "PST") (1 . "#####[~.][~.]#####") (cons 410 (getvar 'ctab)))))
  13.              (progn ; then
  14.               (setvar 'cmdecho 0)
  15.               (setq TFDss (ssadd)); initially empty duplicates selection set
  16.               (repeat (setq n (sslength mss))
  17.                 (setq tc (cdr (assoc 1 (entget (ssname mss (setq n (1- n)))))))
  18.                   ; = text content of each
  19.                 (cond
  20.                   ((member tc duplist))
  21.                     ; = already in duplicates list [do nothing]
  22.                   ((member tc tclist) (setq duplist (cons tc duplist)))
  23.                     ; = already in content list [put in duplicates list]
  24.                   ((setq tclist (cons tc tclist)))
  25.                     ; = first instance of it [put in content list]
  26.                 ); cond
  27.               ); repeat
  28.      
  29.              
  30.               (setq col 0); base value for counting color numbers upward
  31.              
  32.               (foreach tc duplist ; assign colors to sets of duplicates
  33.         ;;;     (setq tcss (ssget "_X" (list '(0 . "*TEXT")'(8 . "PST") (cons 1 tc))))      
  34.                 (setq tcss (ssget "_X" (list (0 . "*TEXT") (8 . "PST") (1 . "#####[~.][~.]#####") (cons 1 tc))))
  35.         ;;;     (command "_.layer" "_make" "Text" "_color" 7 "" "")
  36.         ;;;     (command "_.chprop" tcss "" "_color" (setq col (1+ col)) "")
  37.         ;;;     (command "_.chprop"  tcss "" "_layer" "Text" "")
  38.                 (command "_.chprop" tcss "" "_color" 230 "")
  39.                 (repeat (setq n (sslength tcss)) (ssadd (ssname tcss (setq n (1- n))) TFDss))
  40.                   ; put in collective duplicates selection set
  41.               ); foreach
  42.               (setvar 'cmdecho 1)
  43.               (if (> (sslength TFDss) 0)
  44.                 (sssetfirst nil TFDss); select/grip/highlight
  45.                 (prompt "\nNo Text/Mtext objects with duplicate text content found."); else
  46.               ); if
  47.             ); progn
  48.           ); if
  49.           (vla-endundomark doc)
  50.           (princ)
  51.         ); end defun
  52.        
  53.      

and gives me this error now

Code: [Select]
; error: bad argument type: consp "*TEXT"
how to fix it?

thanks
Logged

ronjonp

  • Needs a day job
  • Posts: 7533
Re: hepl : Search duplicate text, change color
« Reply #18 on: September 28, 2023, 03:51:15 PM »
Code - Auto/Visual Lisp: [Select]
  1. ;; change this
  2. (setq mss  (ssget "_X" (list (0 . "*TEXT") (8 . "PST") (1 . "#####[~.][~.]#####") (cons 410 (getvar 'ctab)))))
  3. ;; to this
  4. (setq mss  (ssget "_X" (list '(0 . "*TEXT") '(8 . "PST") '(1 . "#####[~.][~.]#####") (cons 410 (getvar 'ctab)))))
Logged

Windows 11 x64 - AutoCAD /C3D 2023
Custom Build PC

BIGAL

  • Swamp Rat
  • Posts: 1444
  • 40 + years of using Autocad
Re: hepl : Search duplicate text, change color
« Reply #19 on: September 28, 2023, 09:01:16 PM »
Like Ronjonp I find sometimes rather than mix and match use 1 method. I am a bit old school

Code: [Select]
(setq mss  (ssget "_X" (list (cons 0 "*TEXT") (cons 8  "PST") (cons 1  "#####[~.][~.]#####") (cons 410 (getvar 'ctab)))))
Logged
A man who never made a mistake never made anything

danAllen

  • Newt
  • Posts: 134
Re: hepl : Search duplicate text, change color
« Reply #20 on: September 29, 2023, 12:10:22 AM »
after beating my head figuring out the ' vs cons problem, I just use cons & list now to be safe. And I still double quote getvars
Code - Auto/Visual Lisp: [Select]
  1. (setq mss  (ssget "_X" (list (cons 0 "*TEXT") (cons 8  "PST") (cons 1  "#####[~.][~.]#####") (cons 410 (getvar "ctab")))))
Logged

Lee Mac

  • Seagull
  • Posts: 12929
  • London, England
Re: hepl : Search duplicate text, change color
« Reply #21 on: September 29, 2023, 03:41:14 AM »
Quote from: danAllen on September 29, 2023, 12:10:22 AM
after beating my head figuring out the ' vs cons problem, I just use cons & list now to be safe. And I still double quote getvars

Perhaps this can help?
Logged

danAllen

  • Newt
  • Posts: 134
Re: hepl : Search duplicate text, change color
« Reply #22 on: September 29, 2023, 11:07:35 AM »
Lee - thanks for that reference. I think my past challenge resulted from most sources of ssget filters use of (' / apostrophe / single quote) instead of list. And then if cons is substituted to use a variable in the filter, the ' must be replaced with list, which is not intuitive. For my own programming I think it is better to limit use of ' for easier substitution of variables (that get evaluated) instead of constants.
Logged

mhy3sx

  • Newt
  • Posts: 129
Re: hepl : Search duplicate text, change color
« Reply #23 on: October 09, 2023, 03:44:28 AM »
I have to explain again what I am looking for.

I don't want to select all the text in the layer.

I have two types of text. The form of the text is like   061676614011 (12 numbers) or something like this 06167AG01949. The numbers are changing but the text AG if exist in the text is all the time the same and in the same possition (in the midle of the text). 

I already have a code that select all the duplicate text in the drawing (from PST layer) and change color.

I want an extra check for this texts in PST Layer, and the check is

To search if in this layer exist a text with problem in spelling. If a text is not like  061676614011 (12 numbers) or something like this 06167AG01949 , is something alse for example
06167661401G , 06167AK01949, O6167AG01949, D6167AG01949 etc  the select and this spesific text and change the color to this text .

Code - Auto/Visual Lisp: [Select]
  1. (defun C:TFD (/ *error* doc mss n tc tclist duplist tcss); = Text [& Mtext] Find Duplicates
  2.       (defun *error* (errmsg)
  3.         (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
  4.           (princ (strcat "\nError: " errmsg))
  5.         ); if
  6.         (setvar cmdecho 1)
  7.         (vla-endundomark doc)
  8.         (princ)
  9.       ); defun - *error*
  11.          (if (setq mss (ssget "_X" (list '(0 . "*TEXT") '(8 . "PST")(cons 410 (getvar 'ctab)))))
  12.          (progn ; then
  13.           (setvar 'cmdecho 0)
  14.           (setq TFDss (ssadd)); initially empty duplicates selection set
  15.           (repeat (setq n (sslength mss))
  16.             (setq tc (cdr (assoc 1 (entget (ssname mss (setq n (1- n)))))))
  17.               ; = text content of each
  18.             (cond
  19.               ((member tc duplist))
  20.                 ; = already in duplicates list [do nothing]
  21.               ((member tc tclist) (setq duplist (cons tc duplist)))
  22.                 ; = already in content list [put in duplicates list]
  23.               ((setq tclist (cons tc tclist)))
  24.                 ; = first instance of it [put in content list]
  25.             ); cond
  26.           ); repeat
  27.  
  28.          
  29.           (setq col 0); base value for counting color numbers upward
  30.          
  31.           (foreach tc duplist ; assign colors to sets of duplicates
  32.            (setq tcss (ssget "_X" (list '(0 . "*TEXT")'(8 . "PST") (cons 1 tc))))      
  33.     ;;;     (command "_.layer" "_make" "Text" "_color" 7 "" "")
  34.     ;;;     (command "_.chprop" tcss "" "_color" (setq col (1+ col)) "")
  35.     ;;;     (command "_.chprop"  tcss "" "_layer" "Text" "")
  36.             (command "_.chprop" tcss "" "_color" 230 "")
  37.             (repeat (setq n (sslength tcss)) (ssadd (ssname tcss (setq n (1- n))) TFDss))
  38.               ; put in collective duplicates selection set
  39.           ); foreach
  40.           (setvar 'cmdecho 1)
  41.           (if (> (sslength TFDss) 0)
  42.             (sssetfirst nil TFDss); select/grip/highlight
  43.             (prompt "\nNo Text/Mtext objects with duplicate text content found."); else
  44.           ); if
  45.         ); progn
  46.       ); if
  47.       (vla-endundomark doc)
  48.       (princ)
  49.     ); end defun
  50.      
  51.  
  52.  

Thanks
Logged
Pages: 1 [2]  All |   Go Up
« previous next »