Topic: hepl : Search duplicate text, change color

[mhy3sx]

Hi, I am trying to update an old code

1)  for search duplicate text in the drawing and change them color. The code do this, but I want to search only PST layer not all layers


2) Check the spelling of the text . The text all the time must be like 061676614011 (12 numbers) or something like this 06167AG01949 (5 numbers AG 5 numbers). I want to check this the 12 numbers (with no letters) or 5 numbers AG 5 numbers , the AG in the middle.

This is the code

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*
10.   (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
11.   (if (setq mss (ssget "_X" (list '(0 . "*TEXT") (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.       (setq col 0); base value for counting color numbers upward
28.       (foreach tc duplist ; assign colors to sets of duplicates
29.         (setq tcss (ssget "_X" (list '(0 . "*TEXT") (cons 1 tc))))
30.         (command "_.layer" "_make" "Text" "_color" 7 "" "")
31. ;;;        (command "_.chprop" tcss "" "_color" (setq col (1+ col)) "")
32. ;;;     (command "_.chprop"  tcss "" "_layer" "Text" "")
33.        (command "_.chprop" tcss "" "_color" 230 "")
34.         (repeat (setq n (sslength tcss)) (ssadd (ssname tcss (setq n (1- n))) TFDss))
35.           ; put in collective duplicates selection set
36.       ); foreach
37.       (setvar 'cmdecho 1)
38.       (if (> (sslength TFDss) 0)
39.         (sssetfirst nil TFDss); select/grip/highlight
40.         (prompt "\nNo Text/Mtext objects with duplicate text content found."); else
41.       ); if
42.     ); progn
43.   ); if
44.   (vla-endundomark doc)
45.   (princ)
46. ); end defun
47.  

Can anyone help? Thanks

[HOSNEYALAA]

hi

Sorry my language is not good
did not I understand  Request 2

1)

Code: [Select]


    (defun C:TFD (/ *error* doc mss n tc tclist duplist tcss); = Text [& Mtext] Find Duplicates
      (defun *error* (errmsg)
        (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
          (princ (strcat "\nError: " errmsg))
        ); if
        (setvar cmdecho 1)
        (vla-endundomark doc)
        (princ)
      ); defun - *error*
      (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
      (if (setq mss (ssget "_X" (list '(0 . "*TEXT") '(8 . "PST")(cons 410 (getvar 'ctab)))))
        (progn ; then
          (setvar 'cmdecho 0)
          (setq TFDss (ssadd)); initially empty duplicates selection set
          (repeat (setq n (sslength mss))
            (setq tc (cdr (assoc 1 (entget (ssname mss (setq n (1- n)))))))
              ; = text content of each
            (cond
              ((member tc duplist))
                ; = already in duplicates list [do nothing]
              ((member tc tclist) (setq duplist (cons tc duplist)))
                ; = already in content list [put in duplicates list]
              ((setq tclist (cons tc tclist)))
                ; = first instance of it [put in content list]
            ); cond
          ); repeat

         
          (setq col 0); base value for counting color numbers upward
         
          (foreach tc duplist ; assign colors to sets of duplicates
            (setq tcss (ssget "_X" (list '(0 . "*TEXT")'(8 . "PST") (cons 1 tc))))
            (command "_.layer" "_make" "Text" "_color" 7 "" "")
    ;;;        (command "_.chprop" tcss "" "_color" (setq col (1+ col)) "")
    ;;;     (command "_.chprop"  tcss "" "_layer" "Text" "")
           (command "_.chprop" tcss "" "_color" 230 "")
            (repeat (setq n (sslength tcss)) (ssadd (ssname tcss (setq n (1- n))) TFDss))
              ; put in collective duplicates selection set
          ); foreach
          (setvar 'cmdecho 1)
          (if (> (sslength TFDss) 0)
            (sssetfirst nil TFDss); select/grip/highlight
            (prompt "\nNo Text/Mtext objects with duplicate text content found."); else
          ); if
        ); progn
      ); if
      (vla-endundomark doc)
      (princ)
    ); end defun
     




hi

[mhy3sx]

Hi HOSNEYALAA .  Thanks for the reply.

I will explain the request 2

If you see the dwg file, all the text have 12 characters. Some of them are 12 numbers like 061676614011 and some of them have 12 character but the 2 of then in the middle is caps letters like 06167AG01949. I want to do this check. If for example the text is 06167ag01949, ds0616701949, R6167oG01949,etc change the color to text. For letters only the AG caps in the middle 06167AG01949 is correct, and for numbers only the 12 numbers like 061676614011. Is it possible to do this check. All the times we are talking for PST layer.

[danAllen]

You can use # for wildcard for single digit:

Code - Auto/Visual Lisp: [Select]

1. (ssget "_X" (list '(0 . "*TEXT") '(1 . "#####AG#####")))
2. (ssget "_X" (list '(0 . "*TEXT") '(1 . "############")))

to exclude you can prefix with ~

if you want to find all text that does not match the above, you can combine logical operators, see http://www.lee-mac.com/ssget.html#logical

[mhy3sx]

Hi danAllen

if I am not wrong this lines search to select text like  #####AG##### or ############

Code - Auto/Visual Lisp: [Select]

1.     (ssget "_X" (list '(0 . "*TEXT") '(1 . "#####AG#####")))
2.     (ssget "_X" (list '(0 . "*TEXT") '(1 . "############")))
3.  

I want to select the text and change color if the text  is not like #####AG##### or ############. I want to do this check in the spelling of the text.

Thanks

[danAllen]

As I mentioned, combine ~ for not, and AND per LeeMac reference:

Code - Auto/Visual Lisp: [Select]

1. (ssget "X" '((0 . "*TEXT")(-4 . "<AND") (1 . "~#####AG#####")(1 . "~############")(-4 . "AND>")))

[JohnK]

Reminder, you can use a comma.
For example, if you had text:

Code: [Select]

DS0616701949
06167AG01949
061676614011
The following will return the last entries (not the first).

Code - Auto/Visual Lisp: [Select]

1. (ssget "_X" '((0 . "*TEXT") (1 . "############,#####AG#####")))

The following will select the first line (not the second or third).

Code - Auto/Visual Lisp: [Select]

1. (ssget "_X" '((0 . "*TEXT")(-4 . "<NOT") (1 . "#####AG#####,############")(-4 . "NOT>")))

[danAllen]

good point. I find it interesting/frustrating that this does not work, as it selects all three:

Code - Auto/Visual Lisp: [Select]

1. (ssget "_X" '((0 . "*TEXT") (1 . "~############,~#####AG#####")))

Logically I understand it. But when using wildcards in dialogs, say a layer filter, I don't know of any workable options. As I understand it, the comma is an OR separator, what is missing is an AND separator.

[JohnK]

Sorry, I'm having a hard time contemplating an AND situation because the comparison is a case-by-case basis (or I am just a dunce).

Adding to our list of text.

Code: [Select]

1. DS0616701949
2. 06167AG01949
3. 061676614011
4. 06167ag01949
5. 06167WG01949
The following will grab all lines except #2 (#1,3,4,5):

Code - Auto/Visual Lisp: [Select]

1. (ssget "_X" '((0 . "*TEXT") (1 . "~#####AG####9")))

The following will only grab #4:

Code - Auto/Visual Lisp: [Select]

1. (ssget "_X" '((0 . "*TEXT") (1 . "#####[a-z][a-z]#####")))

The following will grab #2,3,4,5 (not #1):

Code - Auto/Visual Lisp: [Select]

1. (ssget "_X" '((0 . "*TEXT") (1 . "#####[~.][~.]#####")))

The following will grab #2 and 4:

Code - Auto/Visual Lisp: [Select]

1. (ssget "_X" '((0 . "*TEXT") (1 . "#####AG#####,#####ag#####")))

good point. I find it interesting/frustrating that this does not work, as it selects all three:

Code - Auto/Visual Lisp: [Select]

1. (ssget "_X" '((0 . "*TEXT") (1 . "~############,~#####AG#####")))

Logically I understand it. But when using wildcards in dialogs, say a layer filter, I don't know of any workable options. As I understand it, the comma is an OR separator, what is missing is an AND separator.

[danAllen]

I'm not following? My comment was to agree with your point about using commas, it is more efficient than my solution. My second comment was really just about the limits of typical wildcards in CAD dialogs, I wish there was an additional operator to allow for multiple negations. But at least we have code..

Nice option!

The following will grab #2,3,4,5 (not #1):

Code - Auto/Visual Lisp: [Select]

1. (ssget "_X" '((0 . "*TEXT") (1 . "#####[~.][~.]#####")))

[mhy3sx]

We want to select only the duplicate text and check the spelling, not all the text in the layer.

Thanks

[mhy3sx]

I try this but is not working

Gives me this error

Code: [Select]

; error: bad argument type: consp "<AND"



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*
10.       (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
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") (-4 . "<AND") (1 . "~#####AG#####")(1 . "~############")(-4 . "AND>") (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")(-4 . "<AND") (1 . "~#####AG#####")(1 . "~############") (-4 . "AND>") (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.  
55.  
56.  

[JohnK]

We want to select only the duplicate text and check the spelling, not all the text in the layer.

Thanks

Do you mean simply 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*
10.   (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
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.       (setq col 0); base value for counting color numbers upward
28.       (foreach tc duplist ; assign colors to sets of duplicates
29.         (setq tcss (ssget "_X" (list '(0 . "*TEXT") '(8 . "PST") (cons 1 tc))))
30.         (command "_.layer" "_make" "Text" "_color" 7 "" "")
31. ;;;        (command "_.chprop" tcss "" "_color" (setq col (1+ col)) "")
32. ;;;     (command "_.chprop"  tcss "" "_layer" "Text" "")
33.        (command "_.chprop" tcss "" "_color" 230 "")
34.         (repeat (setq n (sslength tcss)) (ssadd (ssname tcss (setq n (1- n))) TFDss))
35.           ; put in collective duplicates selection set
36.       ); foreach
37.       (setvar 'cmdecho 1)
38.       (if (> (sslength TFDss) 0)
39.         (sssetfirst nil TFDss); select/grip/highlight
40.         (prompt "\nNo Text/Mtext objects with duplicate text content found."); else
41.       ); if
42.     ); progn
43.   ); if
44.   (vla-endundomark doc)
45.   (princ)
46. )

[JohnK]

I try this but is not working

Gives me this error

Code: [Select]

; error: bad argument type: consp "<AND"

...>%

Your code is missing some quote symbols. Can be fixed, but first try the above code (I'm trying to understand your problem).

[JohnK]

I'm not following? My comment was to agree with your point about using commas, it is more efficient than my solution. My second comment was really just about the limits of typical wildcards in CAD dialogs, I wish there was an additional operator to allow for multiple negations. But at least we have code..

Nice option!

The following will grab #2,3,4,5 (not #1):

Code - Auto/Visual Lisp: [Select]

1. (ssget "_X" '((0 . "*TEXT") (1 . "#####[~.][~.]#####")))

Gotcha. All good.