Jump to content

The Best Text Find And Replace LISP Ever...


Freerefill

Recommended Posts

... is not this one.

 

But, I am fairly pleased with it. It's been quite some time in the making, and I used a different strategy with my code (folks who remember BASIC might crack a smile).

 

I'd just like to post this, and get some feedback. I'm sure there are ways to improve the functionality or efficiency, namely removing Visual LISP so that it's more backwards compatible, or adding an option to go back up a menu or two, or even alter the selection set (or, put the selection set elsewhere, since text-heavy drawings like landbases with street names would lag when this LISP is called).

 

Any advice would be greatly appreciated. Thank you. ^.^

 

;-============-;
;- Text  Find -;
;-    *~*     -;
;  Written by -;
; Mark Mercier ;
;   05-06-09   ;
;-============-;

; Improvements:
; Text within blocks
; Improved selection set.. maybe do away with the whole "list" thing and go straight VLA

(defun c:tfind()
 (tfindfun nil nil 0)
 )

(defun tfindfun(inputF inputR caseSn / goto goWhile strinF strinR selSet selTxt searep case count error)
 ; 01 Create selection set. GOTO 02 if success, or GOTO 08 if fail
 ; 02 Check passed input. If both nil, GOTO 03. If first string and second nil, GOTO 06. If both strings, GOTO 07. Otherwise, return error and GOTO 08
 ; 03 Display menus and obtain data from user. If Search, GOTO 04. If Replace, GOTO 05
 ; 04 Search option selected. Prompt user for single search term. GOTO 06
 ; 05 Replace option selected. Prompt user for search term and replace term. GOTO 07
 ; 06 One string has been passed. Assume automatic search. Run same as current (tfind). GOTO FINISH
 ; 07 Two strings have been passed. Assume automatic replace. Pass both strings to (replace) function. GOTO FINISH
 ; 08 FINISH. Return errors if needed. End loop and program.
 (vl-load-com)
 (setq goTo 1)
 (setq goWhile 1)
 (setq count 0)
 (if (not (mlml (list caseSn) (list 0 1))) (progn (setq goWhile nil) (princ "\nCase selection not recognized.")))
 (if (= caseSn 0) (setq case "N") (setq case "Y"))
 (while goWhile
   (cond
     ((= goTo 1)
      (setq selSet (extTxtPt (ssget "_X" (list (cons -4 "<OR") (cons 0 "TEXT,MTEXT") (cons -4 "<AND") (cons 0 "INSERT") (cons 66 1) (cons -4 "AND>") (cons -4 "OR>")))))
      (if selSet (setq goTo 2) (setq error "\nSelection set not found." goTo )
      )
     ((= goTo 2)
      ; Check input, pass to whatever.
      (cond
    ((and (= inputF nil) (= inputR nil))
     (setq goTo 3)
     )
    ((and (= (type inputF) 'STR) (= inputR nil))
     (setq strinF inputF)
     (setq goTo 6)
     )
    ((and (= (type inputF) 'STR) (= (type inputR) 'STR))
     (setq strinF inputF)
     (setq strinR inputR)
     (setq goTo 7)
     )
    (t
     (setq error "\nPassed arguments are not accepted.")
     (setq goTo 
     )
    )
      )
     ((= goTo 3)
      ; Obtain desired option from user
      (while (not (mlml (list (setq searep (strcase (getstring nil "\nSelect option [Find/Replace/Quit/Case]: "))))
                (list "F" "FIND" "R" "REPLACE" "Q" "QUIT" "C" "CASE")
                ))
    )
      (cond
    ((mlml (list searep) (list "F" "FIND"))
     (setq goTo 4)
     )
    ((mlml (list searep) (list "R" "REPLACE"))
     (setq goTo 5)
     )
    ((mlml (list searep) (list "Q" "QUIT"))
     (setq goTo 
     )
    ((mlml (list searep) (list "C" "CASE"))
     (while (not (mlml (list (setq case (strcase (getstring nil "\nCase sensitive? [Yes/No]: "))))
                   (list "Y" "YES" "N" "NO")
                   ))
       )
     )
    )
      )
     ((= goTo 4)
      ; Obtain search string from user, set to strinF
      (while (eq "" (setq strinF (getstring T "\nEnter search term: "))))
      (setq goTo 6)
      )
     ((= goTo 5)
      ; Obtain search string and replace string from user, set to strinF and strinR respectively
      (while (eq "" (setq strinF (getstring T "\nEnter find term: "))))
      (while (eq "" (setq strinR (getstring T "\nEnter replace term: "))))
      (setq goTo 7)
      )
     ((= goTo 6)
      ; Search drawing for strinF
      (cond
    ((mlml (list case) (list "Y" "YES"))
     ; Compare using (vl-string-search strinF input), view selection
     ; use "while" to get all search occurances
     (foreach selVar selSet
       (if (vl-string-search strinF (nth 0 selVar))
         (progn
       (setq count (1+ count))
       (if (/= (getvar "ctab") (caddr selVar)) (command "ctab" (caddr selVar)))
       (command "zoom" "c" (trans (cadr selVar) 0 1) (* 32 (nth 3 selVar)))
       (getstring "\nPress 'Enter' to continue: ")
       )
         )
       )
     )
    ((mlml (list case) (list "N" "NO"))
     ; Compare using (vl-string-search (strcase strinF) (strcase input)), view selection
     ; use "while" to get all search occurances
     (foreach selVar selSet
       (if (vl-string-search (strcase strinF) (strcase (nth 0 selVar)))
         (progn
       (setq count (1+ count))
       (if (/= (getvar "ctab") (caddr selVar)) (command "ctab" (caddr selVar)))
       (command "zoom" "c" (trans (cadr selVar) 0 1) (* 32 (nth 3 selVar)))
       (getstring "\nPress 'Enter' to continue: ")
       )
         )
       )
     )
    )
      (if (= count 0) (setq error "\nNo matches found.") (setq error (strcat (itoa count) " matches found.")))
      (setq goTo 
      )
     ((= goTo 7)
      ; Replace strinF with strinR
      (cond
    ((mlml (list case) (list "Y" "YES"))
     ; Compare using (vl-search-string strinF input), modify using (vl-string-subst) within a while loop
     (foreach selVar selSet
       (setq selTxt (nth 0 selVar))
       (setq seaLoc 0)
       (while (setq seaLoc (vl-string-search strinF selTxt seaLoc))
         (setq selTxt (vl-string-subst strinR strinF selTxt seaLoc))
         (setq seaLoc (+ seaLoc (strlen strinR)))
         (setq count (1+ count))
         )
       (vla-put-TextString (vlax-ename->vla-object (nth 4 selVar)) selTxt)
       )
     )
    ((mlml (list case) (list "N" "NO"))
     ; Compare using (vl-string-search (strcase strinF) (strcase input)), modify using (vl-string-subst) within a while loop
     (foreach selVar selSet
       (setq selTxt (nth 0 selVar))
       (setq seaLoc 0)
       (while (setq seaLoc (vl-string-search (strcase strinF) (strcase selTxt) seaLoc))
         (setq selTxt (strcat (substr selTxt 1 seaLoc) strinR (substr selTxt (+ 1 seaLoc (strlen strinF)))))
         (setq seaLoc (+ seaLoc (strlen strinR)))
         (setq count (1+ count))
         )
       (vla-put-TextString (vlax-ename->vla-object (nth 4 selVar)) selTxt)
       )
     )
    )
      (if (= count 0) (setq error "\nNo occurances found.") (setq error (strcat (itoa count) " occurances modified.")))
      (setq goTo 
      )
     ((= goTo 
      (if error (princ error))
      (setq goWhile nil)
      )
     )
   )
 (princ)
 )

(defun mlml(inSMLChar inSMLStri / returnVarMS toCheck chkWith)
 (setq returnVarMS nil)
 (if (and (= (type inSMLChar) 'LIST)
      (= (type inSMLStri) 'LIST)
      )
   (progn
     (foreach toCheck inSMLStri
   (foreach chkWith inSMLChar
     (if (eq toCheck chkWith) (setq returnVarMS T))
     )
   )
     );/progn
   )
 returnVarMS
 ); Checks a list to see if a member of that list is the same as a member of another list. Returns T or nil

(defun extTxtPt(ssList / subVar getEnt entTyp entTxt entPnt entLay entHgt grp66 entAtt getEntAtt entAttTyp uniLst)
 (setq uniLst nil)
 (setq subVar 0)
 (if ssList
 (repeat (sslength ssList)
   (setq getEnt (entget (cadr (car (ssnamex ssList subVar)))))
   (setq entTyp (cdr (assoc 0 getEnt)))
   (cond
     ((or (= entTyp "TEXT") (= entTyp "MTEXT"))
      (setq entTxt (cdr (assoc 1 getEnt)))
      (setq entPnt (cdr (assoc 10 getEnt)))
      (setq entHgt (cdr (assoc 40 getEnt)))
      (setq entLay (cdr (assoc 410 getEnt)))
      (setq entNam (cdr (assoc -1 getEnt)))

      (setq uniLst (append uniLst (list (list entTxt entPnt entLay entHgt entNam))))
      )
     ((= entTyp "INSERT")
      (setq grp66 (assoc 66 getEnt))
      (if grp66
    (progn
      (setq entAtt (entnext (cdr (assoc -1 getEnt))))
          (setq getEntAtt (entget entAtt))
          (setq entAttTyp (cdr (assoc 0 getEntAtt)))
      )
    )
      (while (= entAttTyp "ATTRIB")
    (setq entTxt (cdr (assoc 1 getEntAtt)))
    (setq entPnt (cdr (assoc 10 getEntAtt)))
        (setq entHgt (cdr (assoc 40 getEntAtt)))
    (setq entLay (cdr (assoc 410 getEntAtt)))
    (setq entNam (cdr (assoc -1 getEntAtt)))
    
    (setq uniLst (append uniLst (list (list entTxt entPnt entLay entHgt entNam))))

    ; Get next entity.
    (setq entAtt (entnext (cdr (assoc -1 getEntAtt))))

    ; Get ent and ent type
    (setq getEntAtt (entget entAtt))
    (setq entAttTyp (cdr (assoc 0 getEntAtt)))
    )
      )
     (t
      )
     )
   (setq subVar (1+ subVar))
   )
   )
 uniLst
 ); Return list of all text-based objects (Text, MText, Attribute) in the current drawing

Link to comment
Share on other sites

  • Replies 46
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    17

  • The Buzzard

    6

  • Freerefill

    6

  • Voaraghamanthar

    6

Top Posters In This Topic

Posted Images

Freerefill,

 

It is a very good routine for a Lisp no doubt, But if it were Dialog driven it would be a nice improvement.

 

Thanks for the share.

The Buzzard

Link to comment
Share on other sites

Nice Program :)

 

Just a quick thing I have noticed - you use a sub-function: mlml... why not use the "member" function to accomplish such a task?

 

Also, with your option selection - why not use an initget, and a getkword, instead of running it through several sub-functions to determine if it is an allowed option?

 

Just a few things I noticed - but good program all the same :)

 

Lee

Link to comment
Share on other sites

Freerefill,

 

It is a very good routine for a Lisp no doubt, But if it were Dialog driven it would be a nice improvement.

 

Thanks for the share.

The Buzzard

 

 

You and your dialogs :P

Link to comment
Share on other sites

Freerefill,

 

It is a very good routine for a Lisp no doubt, But if it were Dialog driven it would be a nice improvement.

 

Thanks for the share.

The Buzzard

 

Indeed! I had considered dialog boxes, but my goal was.. ok, well my original goal was to create one for a guy here who uses R14, which I did do but it never sat well with me how hack my code was.. I've always wanted to improve it.. anyway, my goal was to make one that allowed the user to skip the dialog box, namely the one when you type "FIND", and use it strictly from the command line. Once I got put on AutoCAD 2009 and found that it did not retain the zoom when you searched for something, I realized that the one I made for R14 was actually very suitable, but in order to compete with the existing "FIND" dialog box, it at least needed to be able to replace text. That took a while to figure out, (ultimately I went with Visual LISP, which I suppose killed the goal of making it usable in R14, but the old one still exists, which is good ^^') but I managed it, and now I need to see if what I have can still grow into something more, or change into something better.

 

Thank you for your reply ^^

Link to comment
Share on other sites

Are you up to it Lee?

 

Just a mere bag a shells for someone like you.

 

 

Haha - not sure about that... at that point you might as well use the AutoCAD Find and Replace.

Link to comment
Share on other sites

Also, why not use a Selection Set filter when retrieveing your text based items?

 

At the time of writing it, I was still somewhat new with selection sets and taking data from them. I didn't want a lot of "cons this and that" strewn throughout the code, and also, I couldn't figure out a filter to get block attributes. I figured, if I was going to need a separate function to run through block attributes, I might as well toss the MTEXT and TEXT selection in there as well, and just do all my work with a universal list.

 

EDIT: On second thought, I'm sure there's a way I could use some sort of Visual LISP selection.. but, I'm still a greenhorn to that as well.

Link to comment
Share on other sites

At the time of writing it, I was still somewhat new with selection sets and taking data from them. I didn't want a lot of "cons this and that" strewn throughout the code, and also, I couldn't figure out a filter to get block attributes. I figured, if I was going to need a separate function to run through block attributes, I might as well toss the MTEXT and TEXT selection in there as well, and just do all my work with a universal list.

 

EDIT: On second thought, I'm sure there's a way I could use some sort of Visual LISP selection.. but, I'm still a greenhorn to that as well.

 

I was just considering program running time - Narrowing the selection set to only (cons 0 "TEXT,MTEXT,INSERT") would be much quicker to flick through than just (ssget "X").

 

Also, you could even narrow it down to just attributed blocks, with a filter like this perhaps:

 

(ssget "_X"
      (list (cons -4 "<OR")
              (cons 0 "TEXT,MTEXT")
                (cons -4 "<AND")
                  (cons 0 "INSERT")
                  (cons 66 1)
                (cons -4 "AND>")
            (cons -4 "OR>")))

 

Also, one more thing (sorry if I am sounding too critical here),

 

When you shuffle through the selection set, be careful of using methods that require integer input (i.e. (repeat .... (ssname ss i) ) if you know what I mean, as this will fail with selectionsets of 32767 ents or more.

 

Just a few pointers :)

 

Lee

Link to comment
Share on other sites

Knew you'd come up with something, Lee. ^.^

 

I was bottlenecked into using (ssget "X") because I figured the function I ran it through would be fine to get what I needed, but I didn't consider that it would still be checking every line, polyline, mline, circle, ellipse.. etc.

 

Also, is there any sort of instruction manuel for the (cons -4 "

 

Thanks for the input ^^

 

... and while I'm at it, is there a way to get text and whatnot out of a block that's not an attribute? AutoCAD 2009 lets you replace text that's inside a block, even if it's not an attribute.. I wouldn't mind adding that sort of functionality to this.

Link to comment
Share on other sites

As promised - to retrieve block text:

 

[i][color=#990099];; GetBlockText   by Lee McDonnell   [07.05.09][/color][/i]

[i][color=#990099];; ARGS:[/color][/i]
[i][color=#990099];; Blk   ~  Block Name [str][/color][/i]

[i][color=#990099];; RETURN:[/color][/i]
[i][color=#990099];; List of Text Strings[/color][/i]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] GetBlockText  [b][color=RED]([/color][/b]Blk [b][color=BLUE]/[/color][/b] tStr[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]tblsearch[/color][/b] [b][color=#ff00ff]"BLOCK"[/color][/b] Blk[b][color=RED])[/color][/b]
      [b][color=RED]([/color][/b][b][color=BLUE]foreach[/color][/b] eLst  [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]entget[/color][/b] [b][color=RED]([/color][/b]GetObj [b][color=RED]([/color][/b][b][color=BLUE]tblobjname[/color][/b] [b][color=#ff00ff]"BLOCK"[/color][/b] Blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
        [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdadr[/color][/b] eLst[b][color=RED])[/color][/b] [b][color=#ff00ff]"*TEXT"[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] tStr [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]1[/color][/b] eLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b] tStr[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 tStr[b][color=RED])[/color][/b]

[i][color=#990099]; Get Sub-Entities from Table Def[/color][/i]
[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] GetObj  [b][color=RED]([/color][/b]bObj[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bObj [b][color=RED]([/color][/b][b][color=BLUE]entnext[/color][/b] bObj[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] bObj [b][color=RED]([/color][/b]GetObj bObj[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

Link to comment
Share on other sites

Mighty impressive, Lee. I'm always astounded how you can fit so much into such a small package.

 

Reading through the help file on the functions you used, I began to wonder, is there a difference between a table entity and a regular entity? The help file stated that only (entget) and (entnext) could be used with a return value from (tblnext). Does that exclude (entmod) as well, or any Visual LISP functions?

 

Oh, and in case you were wondering, it took me a full half an hour of solid thinking to muddle through your 9 lines of code, and I still don't fully get it. :P

Link to comment
Share on other sites

Reading through the help file on the functions you used, I began to wonder, is there a difference between a table entity and a regular entity? The help file stated that only (entget) and (entnext) could be used with a return value from (tblnext). Does that exclude (entmod) as well, or any Visual LISP functions?

 

You can use entmod with the entity name returned from "tblobjname", which returns an entity name to represent the table object.

 

As for Visual LISP methods - I wouldn't do work on a table definition entity using VL - I would retrieve the VL object through other means, such as:

 

(vla-get-blocks
 (vla-get-ActiveDocument
   (vlax-get-acad-object)))

 

 

Oh, and in case you were wondering, it took me a full half an hour of solid thinking to muddle through your 9 lines of code, and I still don't fully get it. :P

 

If you do need anything else explained - just ask and I'd be happy to talk you through it :)

Link to comment
Share on other sites

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.


×
×
  • Create New...