Output only PART of text string to .txt file

[RocketBott]

At the moment I have a string of text to represent a wire TB[25] - K201/1.0mm/GY or K201/1.0mm/GY - TB[25] dependant on which side of equipment it's attached to. I need to extract the K201 (wire No.) part to a text file.
All text in the string can change dependant on No.,Size,Colour,Destination. The green parts will be constant.
I have a few lisp's that extract the text string but need to know if there is a way to filter out the wire No.
Idealy the lisp would select all single line text in the dwg, filter out the wire No. then write to a txt file one line per No. in a specified folder with the same file name as the dwg.
I have tried using blocks with attributes but they do not expand with different string lengths & dynamic block have too many problems.
Sample dwg attached.
Thanks

[VVA]

Try this function. It will be return a list of part text string if you want (I hope).
*** ADD Add command GPT

;;Get Part Text
(defun C:GPT ( / file ret count)
  (if (and (setq ret (get-part-text))
	   (setq file (open (strcat "F:\\ENGINEER\\GENERIC\\Label Schedule\\Extracted Labels\\Ferrule_"
            (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname"))4)) ".txt") "a"))
	   )
    (progn
      (mapcar '(lambda(x)(write-line x file)) ret)
      (close file)
      (princ "\nWritting ")
      (princ (length ret))
      (princ " text string to file")
      )
    )
  (princ)
  )
(defun get-part-text ( / ss lst item lst1 lst2 ret)
(vl-load-com)
  ;;;Usage (get-part-text)
  (defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
)
 (if  (setq ss (ssget "_X" (list(cons 0 "TEXT")(cons 410 (getvar "CTAB")))))
   (progn
     (repeat (setq item (sslength ss)) ;_ end setq 
         (setq lst (cons (cdr(assoc 1(entget(ssname ss (setq item (1- item)))))) lst)) 
         )
     (foreach txt lst
       (setq lst1 (str-str-lst txt " "))
       (foreach part-txt lst1
	 (setq lst2 (str-str-lst part-txt "/"))
	 (if (and (> (length lst2) 1)
		  (wcmatch (nth 1 lst2) "*mm")
		  )
	   (setq ret (cons (nth 0 lst2) ret))
	   )
	 )
       )
     )
   )
  ret
  )

[RocketBott]

That works great, thanks a lot.
I'm not getting on very well writng that list to a file. I have created a txt file with

      (setq file (open (strcat "F:\\ENGINEER\\GENERIC\\Label Schedule\\Extracted Labels\\Ferrule_"
            (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname"))4)) ".txt") "a"))

But can't write the string to the file (write-line ret file) ?
I also need each No. on a new line.
Sorry but I'm very new to this and have a lot to learn.

Thanks again

[Lee Mac]

Try

(mapcar '(lambda (x) (write-line x file)) ret)

Also remember to use:

(close file)

at the end, otherwise the file will remain read-only and the data won't be written.

[RocketBott]

Thanks Lee that's it.
I have a long way to go in understand all these different functions.
Thank you both again.

[VVA]

I have a long way to go in understand all these different functions

Add command to #2

[Lee Mac]

Thanks Lee that's it.
I have a long way to go in understand all these different functions.
Thank you both again.

Most people don't quite understand the mapcar and lambda functions too well - just think of it as doing something iteratively to each member of a list and outputting this as all the results in a list.

[RocketBott]

Nice one Vladimir I like the "Writing xxx text string to file" that will be a good check for the printer. I have sorted the list in alphabetical order with acad_strlsort and it's working great.
Cheers Guys.

[RocketBott]

I have hit a problem.
There are some drawings with Wire No,s with a / in them i.e.
TB[25] - K201/S18/1.0mm/GY need the K201/S18 part.
I have made some progress with a solution but have got stuck & I'm sure there will be a better way of solving this.
Got the following which gives what I want on the screen but I can't get it to write to a file. This is only for the "double" Wire No's as above but would be need to combine this with the previous "single" Wire No Lisp.
This one has the user select the text but I will need both options of selection (User & whole drawing) in seperate Lisp files.

(defun c:get-part-text ( / ss lst item lst1 lst2 ret alp)
(vl-load-com)
  ;;;Usage (get-part-text)
  (defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
)
 (if  (setq ss (ssget '((-4 . "<OR")(0 . "TEXT")(-4 . "OR>"))))
   (progn
     (repeat (setq item (sslength ss)) ;_ end setq 
         (setq lst (cons (cdr(assoc 1(entget(ssname ss (setq item (1- item)))))) lst)) 
         )
     (foreach txt lst
       (setq lst1 (str-str-lst txt " "))
       (foreach part-txt lst1
  (setq lst2 (str-str-lst part-txt "/"))
  (if (and (> (length lst2) 1)
    (wcmatch (nth 2 lst2) "*mm")
    )
    (setq ret (cons (strcat (nth 0 lst2) "/" (nth 1 lst2)) ret))
    )
  )
       )
     )
   ) (setq alp (acad_strlsort ret))
  alp
  )

[VVA]

try it

(defun c:get-part-text (/ ss lst item lst1 lst2 ret alp i tmp cnt)
  (vl-load-com)
;;;Usage (get-part-text)
  (defun str-str-lst (str pat / i)
    (cond ((= str "") nil)
	  ((setq i (vl-string-search pat str))
	   (cons (substr str 1 i)
		 (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
	   ) ;_  cons
	  )
	  (t (list str))
    ) ;_  cond
  )
  (if (setq ss (ssget '((-4 . "<OR") (0 . "TEXT") (-4 . "OR>"))))
    (progn
      (repeat (setq item (sslength ss)) ;_ end setq 
	(setq lst
	       (cons
		 (cdr (assoc 1 (entget (ssname ss (setq item (1- item)))))
		 )
		 lst
	       )
	)
      )
      (foreach txt lst
	(setq lst1 (str-str-lst txt " "))
	(foreach part-txt lst1
	  (setq lst2 (str-str-lst part-txt "/"))
	  (if (and (> (length lst2) 1)
		   (setq cnt
			  (vl-member-if '(lambda (x) (wcmatch x "*mm")) lst2)
		   )
	      )
	    (progn
	      (setq cnt (- (length lst2) (length cnt)))
	      (setq i	'-1
		    tmp	nil
	      )
	      (while (< (setq i (1+ i)) cnt)
		(setq tmp (cons (nth i lst2) tmp))
	      )
	      (setq tmp (reverse tmp))
	      (setq
		tmp (strcat
		      (car tmp)
		      (if (cdr tmp)
			(apply '(lambda (x) (strcat "/" x)) (cdr tmp))
			""
		      )
		    )
	      )
	      (setq ret (cons tmp ret))
	    )
	  )
	)
      )
    )
  )
  (setq alp (acad_strlsort ret))
  alp
)