Jump to content

Output only PART of text string to .txt file

RocketBott

By RocketBott
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

RocketBott Apprentice

RocketBott

Posted
Posted

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

04_ITRTR_FR.dwg

VVA Rising Star

VVA

Posted
Posted

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 Apprentice

RocketBott

Posted
  • Author
Posted

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 Grand Master

Lee Mac

Posted
Posted

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 Apprentice

RocketBott

Posted
  • Author
Posted

Thanks Lee that's it.

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

Thank you both again.

VVA Rising Star

VVA

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

Add command to #2

Lee Mac Grand Master

Lee Mac

Posted
Posted
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. :P

RocketBott Apprentice

RocketBott

Posted
  • Author
Posted

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 Apprentice

RocketBott

Posted
  • Author
Posted

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 Rising Star

VVA

Posted
Posted

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
)

Lee Mac Grand Master

Lee Mac

Posted
Posted

Try this: -- provides user with alternative selection methods:

 

 ; TB[25] - K201/1.0mm/GY

 ; K201/1.0mm/GY - TB[25]

 ; TB[25] - K201/S18/1.0mm/GY

(vl-load-com)

(defun gettext    (Str Pat flag / pos pStr)
 (if (setq pos (vl-string-search Pat Str))
   (if    flag
     (setq pStr (substr Str (+ pos 1 (strlen Pat))))
     (setq pStr (substr Str 1 pos))))
 pStr)

(defun c:SubTxt     (/ file ofile choix ss elst t1 t2 2t1 2t2 retlst)
 (or sub:def (setq sub:def "Auto"))
 (initget "Select Auto")
 (if (and (setq file (strcat (getvar "dwgprefix")
                 (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)) ".txt"))
      (setq ofile (open file "a")))
   (progn
     (setq choix (getkword (strcat "\nSelect Text Retrieval Method [select/Auto] <"
                   sub:def
                   ">: ")))
     (or (not choix) (setq sub:def choix))
     (cond ((eq "Auto" sub:def)
        (setq ss (ssget "X"
                (list (cons 0 "*TEXT")
                  (if (getvar "CTAB")
                    (cons 410 (getvar "CTAB"))
                    (cons 67 (- 1 (getvar "TILEMODE"))))))))
       ((eq "Select" sub:def)
        (setq ss (ssget (list (cons 0 "*TEXT")
                  (if (getvar "CTAB")
                    (cons 410 (getvar "CTAB"))
                    (cons 67 (- 1 (getvar "TILEMODE")))))))))
     (if ss
   (progn
     (setq    elst (mapcar
              (function
            (lambda (x) (strcase (cdr (assoc 1 (entget x))))))
              (vl-remove-if
            'listp
            (mapcar 'cadr (ssnamex ss)))))
     (foreach txt    elst
       (cond ((wcmatch (setq t1 (gettext txt " - " T)) "*MM*")
          (setq t2 (vl-string->list (gettext t1 "MM" nil)))
          (while (/= 47 (last t2))
            (setq t2 (reverse (cdr (reverse t2)))))
          (setq retlst    (cons (vl-string-right-trim
                   (chr 47)
                   (vl-list->string t2))
                     retlst)))
         ((wcmatch (setq t1 (gettext txt " - " nil)) "*MM*")
          (setq t2 (vl-string->list (gettext t1 "MM" nil)))
          (while (/= 47 (last t2))
            (setq t2 (reverse (cdr (reverse t2)))))
          (setq retlst    (cons (vl-string-right-trim
                   (chr 47)
                   (vl-list->string t2))
                     retlst)))))
     (mapcar '(lambda (x) (write-line x ofile)) retlst)
     (princ (strcat "\nWriting " (rtos (length retlst)) " lines to file..."))
     (close ofile))
   (princ "\n<!> No Text Found <!>")))
   (princ "\n<!> Unable to Make File <!>"))
 (princ))

RocketBott Apprentice

RocketBott

Posted
  • Author
Posted

Thanks guys I will have a look at those at work tomorrow.

I'm off to Open Night at Primary School with the kids now so I might learn something there to help me get my head round this stuff. :D

Cheers.

Lee Mac Grand Master

Lee Mac

Posted
Posted
Thanks guys I will have a look at those at work tomorrow.

I'm off to Open Night at Primary School with the kids now so I might learn something there to help me get my head round this stuff. :D

Cheers.

 

Haha nice one :D

RocketBott Apprentice

RocketBott

Posted
  • Author
Posted

Vladimir that works perfect thanks.

Lee your code has a problem when a text string without " - " is selected, it gives the error ; error: bad argument type: stringp nil.

It is fine if only selecting the appropriate text.

Lee Mac Grand Master

Lee Mac

Posted
Posted

Ahh, my mistake - I didn't allow for the case in which the text is not in the correct format :oops: silly me:

 

 ; TB[25] - K201/1.0mm/GY

 ; K201/1.0mm/GY - TB[25]

 ; TB[25] - K201/S18/1.0mm/GY

(vl-load-com)

(defun gettext    (Str Pat flag / pos pStr)
 (if (setq pos (vl-string-search Pat Str))
   (if    flag
     (setq pStr (substr Str (+ pos 1 (strlen Pat))))
     (setq pStr (substr Str 1 pos))))
 pStr)

(defun c:SubTxt     (/ file ofile choix ss elst t1 t2 2t1 2t2 retlst)
 (or sub:def (setq sub:def "Auto"))
 (initget "Select Auto")
 (if (and (setq file (strcat (getvar "dwgprefix")
                 (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4))
                 ".txt"))
      (setq ofile (open file "a")))
   (progn
     (setq choix (getkword (strcat "\nSelect Text Retrieval Method [select/Auto] <"
                   sub:def
                   ">: ")))
     (or (not choix) (setq sub:def choix))
     (cond ((eq "Auto" sub:def)
        (setq ss (ssget "X"
                (list (cons 0 "*TEXT")
                  (if (getvar "CTAB")
                    (cons 410 (getvar "CTAB"))
                    (cons 67 (- 1 (getvar "TILEMODE"))))))))
       ((eq "Select" sub:def)
        (setq ss (ssget (list (cons 0 "*TEXT")
                  (if (getvar "CTAB")
                    (cons 410 (getvar "CTAB"))
                    (cons 67 (- 1 (getvar "TILEMODE")))))))))
     (if ss
   (progn
     (setq    elst (mapcar
              (function
            (lambda (x) (strcase (cdr (assoc 1 (entget x))))))
              (vl-remove-if
            'listp
            (mapcar 'cadr (ssnamex ss)))))
     (foreach txt    elst
       (cond ((and (setq t1 (gettext txt " - " T))
           (wcmatch t1 "*MM*"))
          (setq t2 (vl-string->list (gettext t1 "MM" nil)))
          (while (/= 47 (last t2))
            (setq t2 (reverse (cdr (reverse t2)))))
          (setq retlst    (cons (vl-string-right-trim
                   (chr 47)
                   (vl-list->string t2))
                     retlst)))
         ((and (setq t1 (gettext txt " - " nil))
           (wcmatch t1 "*MM*"))
          (setq t2 (vl-string->list (gettext t1 "MM" nil)))
          (while (/= 47 (last t2))
            (setq t2 (reverse (cdr (reverse t2)))))
          (setq retlst    (cons (vl-string-right-trim
                   (chr 47)
                   (vl-list->string t2))
                     retlst)))
         (T nil)))
     (mapcar '(lambda (x) (write-line x ofile)) retlst)
     (princ (strcat "\nWriting " (rtos (length retlst)) " lines to file..."))
     (close ofile))
   (princ "\n<!> No Text Found <!>")))
   (princ "\n<!> Unable to Make File <!>"))
 (princ))

RocketBott Apprentice

RocketBott

Posted
  • Author
Posted

Spot on now Lee.

I hope that put's it to bed now.

So many ways to do the same thing just makes it all the more difficult to know where to start when looking for something like this.

I think I will have to stick to more "simple" code for a while yet.

Once again thank you both very much for your help.

Lee Mac Grand Master

Lee Mac

Posted
Posted
Spot on now Lee.

I hope that put's it to bed now.

So many ways to do the same thing just makes it all the more difficult to know where to start when looking for something like this.

I think I will have to stick to more "simple" code for a while yet.

Once again thank you both very much for your help.

 

Excellent - glad it works for you now :)

 

There are so many ways to approach problems in LISP - its unbelievable how many solutions you can find to the same problem... makes things more exciting :D

 

If you need anything else, or clarification on any aspect of the posted code - just let me know, and I'll be happy to help :)

 

Cheers

 

Lee

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...