Jump to content

Need help to improve on a Quick Find Text lisp program


vernonlee

Recommended Posts

Found this "Find text" lisp written by Mark Mercier aka Freerefill during the course of my work.

 

http://www.cadtutor.net/forum/showthread.php?35933-The-Best-Text-Find-And-Replace-LISP-Ever...

 

I guess he no longer browse here.

 

I found it very useful & quick without have a dialogue box as it slow me down. Was using autocad find command & compare to this, it was way faster.

 

And I see potential where it can further improve especially in terms of speed.

 

So I was wondering if someone can help to adjust the lisp such that :-

1) Find can be the default selection.

So that after running the command, we can start typing the words that we want to find.

 

2) It can search whole words

Currently it seems to search the text like a wildcard which I had to cycle through. I guess that would be good option to have but only when putting *.

 

I hope that it can be adjusted to search whole words by default.

 

Honestly this is a really good lisp.

 

Hope someone capable can see its potential & suggestion to improve it

 

Thanks

 

This is the code

 

;-============-;
;- 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

Find can be the default selection.

So that after running the command, we can start typing the words that we want to find.

;;;-------------------------------------------------------------------
;; This function is freeware courtesy of the author's of "Inside AutoLisp"
;; for rel. 10 published by New Riders Publications.  This credit must
;; accompany all copies of this function.
;;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;;* for INITGET. MSG is the prompt string, to which a default string is added
;;* as <DEF> (nil or "" for none), and a : is added.
;;*
(defun UKWORD (bit kwd msg def / inp)
 (if (and def (/= def ""))
   (setq msg (strcat "\n" msg " <" def "> : ")
         bit (* 2 (fix (/ bit 2)))
         )                             ;setq
   )                                   ;if
 (initget bit kwd)
 (setq inp (getkword msg))
 (if inp inp def)
 )                                     ;defun

 

example: simply [ENTER] = "FIND" as default

(UKWORD 0 "Find Replace Quit Case"
       "\nSelect option [Find/Replace/Quit/Case]: "
"FIND")

Link to comment
Share on other sites

;;;-------------------------------------------------------------------
;; This function is freeware courtesy of the author's of "Inside AutoLisp"
;; for rel. 10 published by New Riders Publications.  This credit must
;; accompany all copies of this function.
;;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;;* for INITGET. MSG is the prompt string, to which a default string is added
;;* as <DEF> (nil or "" for none), and a : is added.
;;*
(defun UKWORD (bit kwd msg def / inp)
 (if (and def (/= def ""))
   (setq msg (strcat "\n" msg " <" def "> : ")
         bit (* 2 (fix (/ bit 2)))
         )                             ;setq
   )                                   ;if
 (initget bit kwd)
 (setq inp (getkword msg))
 (if inp inp def)
 )                                     ;defun

 

example: simply [ENTER] = "FIND" as default

(UKWORD 0 "Find Replace Quit Case"
       "\nSelect option [Find/Replace/Quit/Case]: "
"FIND")

 

Hi hanhphuc.

 

Forgive my ignorance.

 

Do not quite understand. is the attached lisp a standalone or to incoporate into the Find text lisp?

 

If to incoporate, which part & where do i insert i t to?

 

Thanks

Link to comment
Share on other sites

This TFIND.lsp code is by others, so i respect his work which i had replied post #3 earlier in: notifications->inbox :)

maybe you didn't notice?

 

;you try to edit yourself in order you can also learn

; 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")
))
)

to this

(setq searep (strcase
(UKWORD 0 "Find Replace Quit Case"
       "\nSelect option [Find/Replace/Quit/Case]: "
"FIND")
))

Link to comment
Share on other sites

This TFIND.lsp code is by others, so i respect his work which i had replied post #3 earlier in: notifications->inbox :)

maybe you didn't notice?

 

;you try to edit yourself in order you can also learn

; 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")
))
)

to this

(setq searep (strcase
(UKWORD 0 "Find Replace Quit Case"
       "\nSelect option [Find/Replace/Quit/Case]: "
"FIND")
))

 

 

Oops. I sis not realized there was a PM from you. :oops:

 

Understood. Will try it tomorrow. Thanks a lot :)

Link to comment
Share on other sites

I agree with you Sir, undoubtably Lee's routine is great ,but sometimes many OP' still looking for alternative to suit their needs :)

 

No worries; that is why I started my comment with 'For What It's Worth' (aka FWIW). :thumbsup:

Link to comment
Share on other sites

No worries; that is why I started my comment with 'For What It's Worth' (aka FWIW). :thumbsup:

 

Hi BlackBox. I did also came across that lisp from Lee before & did attempt to try though as time was short & seeing that it involves a dialog box, it did not quite provide me a quick text search (akin to Firefox browser search bar, (speaking of which, seriously there should be one)) that i require.

 

So currently the one by Mark Mercier is the quickest that meets closest to my needs which is to zoom to the text (specifically door tags that i am searching in quick succession eg, 1-10... zoom.......1-45... zoom.......4-32... zoom.......& so on.

Though i still need to find whole words instead of searching like a wildcard. :ouch:

(when i type 1-2, it will cycle to 1-21, 1-22, 1-23, 1-24...........................................then finally 1-2 :facepalm:

 

So basically i not able to open that or any lisp that uses a search box, type into the spae provided, move the mouse to click enter, wait for dialog box to close & zoom to the door tag then repeat repeat all over again.

 

Basically command line still works faster in this case.

 

That said, i am open to suggestion. As long as it is faster then what i am curently doing

 

I so like to add that I also use some of lee's lisp and is nothing short of amazing.

Edited by vernonlee
Link to comment
Share on other sites

Though i still need to find whole words instead of searching like a wildcard. :ouch:

(when i type 1-2, it will cycle to 1-21, 1-22, 1-23, 1-24...........................................then finally 1-2 :facepalm:

 

for whole word: skip these vl-string-search ,

ie: get stringF and selection strings matched enough.

*pm*

 

EDIT: If you choose whole-word-match, be careful whether it works for some formatted MTEXT?

Edited by hanhphuc
Link to comment
Share on other sites

  • 2 months later...

Bump up for further assistance :(

 

hanhphuc has already helped me modified the lisp to have FIND as a default selection.

 

Item 2 i am still lost on this.

 

2) It can search whole words

Currently it seems to search the text like a wildcard which I had to cycle through. I guess that would be good option to have but only when putting *.

 

I hope that it can be adjusted to search whole words by default.

Hope someone can suggest something for the lisp to allow it to search whole words instead. And to only allow wildcard searches when * is indicated.

 

Thanks

 

This is the code which has FIND as a default selection

 

;-============-;
;- 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
http://www.cadtutor.net/forum/showthread.php?35933-The-Best-Text-Find-And-Replace-LISP-Ever...

(defun c:tfind( / *object* )
(or *object*   (setq *object* (vlax-get-acad-object)))
 (tfindfun nil nil 0)
 )

(defun-q 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")
;;;                 ))
;;;     )
      
;;;v1.1: 
(setq searep (strcase
(UKWORD 0 "Find Replace Quit Case"
       "\nSelect option [Find/Replace/Quit/Case]: "
   "FIND")
))

      
      (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))
    (eq strinF (car selVar)) ;v1.1
         (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))); v1.1:removed
   (vla-ZoomCenter *object* (vlax-3d-point (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))) ;
      (eq (strcase strinF) (strcase (nth 0 selVar))) ;v1.1
         (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))) ; v1.1:removed
   (vla-ZoomCenter *object* (vlax-3d-point (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)
   (if
   (= (car selVar) strinF)  
   (vla-put-TextString (vlax-ename->vla-object (nth 4 selVar)) strinR ))
       )
     )
    ((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(=(strcase (car selVar))(strcase strinF)) 
   (vla-put-TextString (vlax-ename->vla-object (nth 4 selVar)) strinR ))
   
       )
     )
    )
      (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

;("1.x11" (1307.62 1349.77 0.0) "Model" 51.5188 <Entity name: 7efa8af0>) 


;;;-------------------------------------------------------------------
;; This function is freeware courtesy of the author's of "Inside AutoLisp"
;; for rel. 10 published by New Riders Publications.  This credit must
;; accompany all copies of this function.
;;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;;* for INITGET. MSG is the prompt string, to which a default string is added
;;* as <DEF> (nil or "" for none), and a : is added.
;;*
(defun UKWORD (bit kwd msg def / inp)
 (if (and def (/= def ""))
   (setq msg (strcat "\n" msg " <" def "> : ")
         bit (* 2 (fix (/ bit 2)))
         )                             ;setq
   )                                   ;if
 (initget bit kwd)
 (setq inp (getkword msg))
 (if inp inp def)
 )           

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...