Topic: Search text after string

[cadplayer]

Hi!

I´m looking for a tool which can search Textstrings and calculate them how much it find in drawing.
I try to begin that, but I´m really down and can´t continue, can somebody help me ?

Code: [Select]

; Lösche duplicates in Liste
(defun _RemoveDuplicates ( lst / foo index )
    (defun foo (x)
        (cond
            ((vl-position x index))
            ((null (setq index (cons x index))))
        )
    )
    (vl-remove-if
       'foo
        lst
    )
  )

(defun c:searchText (/ txt ss i ent layEnt layList layTXT txtwert txtliste )
  (if (not x) (setq x ""))
  (if (null (setq txt (getstring (strcat "\nSearch [text] <" x ">: "))))
    (setq txt x)
    (setq x txt)
    )
  (if (setq ss (ssget "_X" '((8 . "H_N_VA*") (0 . "TEXT") (-4 . "<NOT") (-4 . "*") (420 . 0) (-4 . "NOT>"))) i 0)
    (repeat (sslength ss)
      (setq ent (ssname ss i))
      (progn
(setq layEnt (cons ent (cdr (assoc 1 (entget ent)))))
(setq layList (cons layEnt layList))
)
      )
    )

 
  (setq tl (strlen txt))
 (if (setq layTXT (_RemoveDuplicates (mapcar 'cdr layList)) txtwert 0)
   (foreach N layList
     (if (= (cdr N) (car layTXT))
       (progn
(setq txtwert (cdr (assoc 1 (entget (car N)))))
(setq txtliste (cons txtwert txtliste))
)
       )
    )
  (princ)
  )

 

[Lee Mac]

Maybe:

Code - Auto/Visual Lisp: [Select]

1. (defun c:tfind ( / sel )
2.     (if
3.         (setq sel
4.             (ssget "_X"
5.                 (list '(0 . "TEXT")
6.                     (cons 1
7.                         (apply 'strcat
8.                             (mapcar '(lambda ( x ) (strcat "[" (chr x) (strcase (chr x) t) "]"))
9.                                 (vl-string->list (strcase (getstring t "\nEnter Text: ")))
10.                             )
11.                         )
12.                     )
13.                 )
14.             )
15.         )
16.         (print (sslength sel))
17.         (princ "\nText not found.")
18.     )
19.     (princ)
20. )

[cadplayer]

Really complex - I have to study.
Thanks so much Lee

[Lee Mac]

You're welcome; if you aren't worried about case-sensitivity, the code could be shortened to:

Code - Auto/Visual Lisp: [Select]

1. (defun c:tfind ( / sel )
2.     (if (setq sel (ssget "_X" (list '(0 . "TEXT") (cons 1 (getstring t "\nEnter Text: ")))))
3.         (print (sslength sel))
4.         (princ "\nText not found.")
5.     )
6.     (princ)
7. )

[cadplayer]

Thanks Lee for fast answering, I´m little busy right now, but I come back if I understand more what you have done.
Thanks a lot

[cadplayer]

A question more, if I want have all text with prefix TB- , VA-, TELE I was thinking it would goes like this, but I doesn´t.

Code: [Select]

(defun c:test ()
  (if (setq ss (ssget "_X" '((8 . "H_N*") (0 . "TEXT") (-4 . "<NOT") (-4 . "*") (420 . 0) (-4 . "NOT>"))) i -1)
    (repeat (sslength ss)
      (setq ent (ssname ss (setq i (1+ i))))
      (if (tfind (setq y (substr (cdr (assoc 1 (entget ent))) 1 3)))
(princ (strcat "\nValue " y  " is [" (rtos z 2 0) "] in Drawing " ))
)
      )
    )
  (princ)
  )

 (defun tfind (y / sel )
       (if
           (setq sel
               (ssget "X"
                   (list '(0 . "TEXT")
                       (cons 1
                           (apply 'strcat
                               (mapcar '(lambda ( x ) (strcat "[" (chr x) (strcase (chr x) t) "]"))
                                   (vl-string->list (strcase y))
                               )
                           )
                       )

                   )
               )
           )
           (princ (setq z (sslength sel)))
           (princ "\nText not found.")
       )
       (princ)
    )


[Lee Mac]

I suggest something like this:

Code: [Select]

(defun c:test ( / inc itm lst sel str )
    (if (setq sel (ssget "_X" '((0 . "TEXT") (1 . "TB-*,VA-*,TELE*"))))
        (repeat (setq inc (sslength sel))
            (setq str (cdr (assoc 1 (entget (ssname sel (setq inc (1- inc)))))))
            (if (setq itm (assoc str lst))
                (setq lst (subst (cons str (1+ (cdr itm))) itm lst))
                (setq lst (cons  (cons str 1) lst))
            )
        )
    )
    (mapcar 'print lst)
    (princ)
)

[cadplayer]

Wonderfull Lee!
I must slowly go through the code, I didn´t really understand what happens in the end. But give me little time, after weekend I understand it ...

[Lee Mac]

You're welcome Dirk, ask if you are unsure about the code. 

[cadplayer]

Its a little complicate to understand this part of your code

Code: [Select]

(apply 'strcat
                               (mapcar '(lambda ( x ) (strcat "[" (chr x) (strcase (chr x) t) "]"))
                                   (vl-string->list (strcase y))
                               )

what did it do ?
How can I debugg x with vlide?

[CAB]

Maybe this will explain it:

Code - Auto/Visual Lisp: [Select]

1. (apply 'strcat   ; this combines the strings returned by the mapcar
2.  
3.     (mapcar '(lambda ( x ) ; the following returns a string
4.                (strcat ; combine string
5.                   "["  ; this character
6.                   (chr x) ; convert number to ascii character
7.                   (strcase (chr x) t) ; convert number to ascii character & force to lower case
8.                   "]"  ; this character
9.                 ) ; end strcat
10.               ) ; end lanbda
11.    
12.         ; the following is the list of ascii numbers fed to the lambda function
13.         (vl-string->list (strcase y)) ; convert string y to upper case & return a list of ascii numbers
14.     ) ; end mapcar
15.    
16. ) ; end apply

[Lee Mac]

Code: [Select]

(apply 'strcat
    (mapcar '(lambda ( x ) (strcat "[" (chr x) (strcase (chr x) t) "]"))
        (vl-string->list (strcase y))
    )
)What did it do?

Evaluating the code expression-by-expression:

Code: [Select]

_$ (setq y "test")
"test"
_$ (strcase y)
"TEST"
_$ (vl-string->list (strcase y))
(84 69 83 84)
_$ (mapcar '(lambda ( x ) (strcat "[" (chr x) (strcase (chr x) t) "]")) (vl-string->list (strcase y)))
("[Tt]" "[Ee]" "[Ss]" "[Tt]")
_$ (apply 'strcat (mapcar '(lambda ( x ) (strcat "[" (chr x) (strcase (chr x) t) "]")) (vl-string->list (strcase y))))
"[Tt][Ee][Ss][Tt]"
Since the DXF Group 1 code of the ssget filter list is case-sensitive, the above expressions construct a wildcard pattern that will match both the uppercase and lowercase variants of each character of the given string.

[cadplayer]

Thanks so much Lee

Have a nice we!