Jump to content

Text Change Through Multiple Drawings.


Recommended Posts

Posted

I have searched for an easier way to do this and found Lee's MacAtt.lsp which is very close to what I need, but I need it to change text strings such as Multiple line, Single line, and Attribute Values. I don't need it to call out a specific block, or specific attribute to find because I just need to change already existing text. Currently I use RepString.lsp using ScriptPro to run it through multiple drawings. Anyone have a LISP file that can do this? I just need options:

what text to find.

what to change the text too.

select folder that contains the drawings I want to change this text in.

Posted

You can take a look at the Text Find/Replace and Batch Engine links in my signature. That should be everything you need. If you need more help on how to use them, send me a private message on this forum or email me. I'd be more than happy. ^.^

Posted

Wow... You added so many options to you batch engine. You should think about creating a menu to make it a little more user friendly, unless I am missing something. This does seem to have the options I am looking for, but I will have to play with it a while to figure out exactly how to use it for what I am after.

 

Thank you for your help.

  • 3 weeks later...
Posted

This is what I am looking for... I need to figure out how to make some adjustments to it to fit my needs, but for anyone who was wanting something similar to what i explained, this is it.

  • 14 years later...
Posted

Hi, I'm getting drawings where I've to change one text, same in all. Trying to find way to do it and can't seem to get anything to work. Maybe cause drawings are coming from Japan, I've multiple drawings all with same change. Drawing attached for reference. Text on title bloct needs to change from K_MAA to A_MAA

A_MAA346939.dwg

Posted
1 hour ago, bbreal said:

Hi, I'm getting drawings where I've to change one text, same in all. Trying to find way to do it and can't seem to get anything to work. Maybe cause drawings are coming from Japan, I've multiple drawings all with same change. Drawing attached for reference. Text on title bloct needs to change from K_MAA to A_MAA

A_MAA346939.dwg 1.34 MB · 0 downloads

What have you tried so far?

 

Do you have the Japanese version of AutoCAD or some other?

 

The "TEXT" you are trying to change is an "ATTRIBUTE".

 

Try Batch Find & Replace Text | Lee Mac Programming (lee-mac.com) should work with Attributes.

Posted

Hi, I have normal Uk/Irl cad. I tried that from Lee and doesnt work. It works on single drawing but not on a folder of drawings. No idea why. I changed loads of settings on the software with no luck. 

Posted

This is a command line find and replace function, which should work through say Lee Macs script writer or scriptwriter pro.

 

Command is: (FindReplaceNew old_text new_text)

 

It is case sensitive, it will change  K_MAA to A_MAA but not k_mma

 

I didn't update - had to quickly add a regen at the end of the code, see if it works - did for me with a quick test just then

 

 

(defun FindReplaceNew (Find$ Replace$ / SS acounter acount ent1 entlist1 entcodes1 EntType Text$ text01 ReplaceWith$ FoundReplaced NewTxt MyBlockEntList BlockCounter )
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-text/td-p/5649883
;;;Sub Routines ;;;;
;;;;;;;;;;;;;;;;;;;;
;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-entities-inside-a-block/td-p/2644829
  (defun getblkitems ( EntName / sel items) ;;Blocks:
    (setq nfo (entget EntName))
    (progn
      (vlax-for item (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object) ) )
                     (cdr (assoc 2 nfo)) )
                    (setq items (cons (vlax-vla-object->ename item) items))
      ) ;end vlax
    ) ; end progn
  ) ;end defun
  (defun updateblock ( EntType ent1 entlist1 acount Find$ Replace$ / MyBlockEntList BlockCounter EntType2 ent2 entlist2 )
    (if (= EntType "INSERT")
      (progn
;;Updates block texts & block blocks
        (setq MyBlockEntList (getblkitems ent1) )
        (setq BlockCounter 0)
        (while (< BlockCounter (length MyBlockEntList))
          (setq ent2 (nth BlockCounter MyBlockEntList))
          (setq entlist2 (entget ent2))
          (setq EntType2 (cdr (assoc 0 entlist2)) )
;;Attrributes
          (setq acount (updateattribvalues EntType ent1 entlist1 acount Find$ Replace$))
;;Texts
          (if (or (= EntType2 "TEXT")(= EntType2 "MTEXT")(= EntType2 "MULTILEADER")) ;;attributes?
            (setq acount (updatetext EntType2 ent2 entlist2 acount Find$ Replace$))
          ); end if
;;Changes Dimensions
          (if (or (= EntType2 "DIMENSION") )
            (if (= (cdr (assoc 1 entlist2)) "") ;;if has text over ride
              ()
              (progn
                (setq acount (updatetext EntType2 ent2 entlist2 acount Find$ Replace$)) ;;same as text -if- ent code 4 used
                (command ".-refedit" (cdr (assoc 10 entlist1)) "ok" "all" "yes") ;;update block definition
                (command "refclose" "s")
              );end progn
            ) ;end if
          ); end if
          (if (= EntType2 "ACAD_TABLE")
            (setq acount (UpdateTable EntType2 ent2 entlist2 acount Find$ Replace$))
          );end if
          (if (= EntType2 "INSERT") ;;Blocks
            (setq acount (updateblock EntType2 ent2 entlist2 acount Find$ Replace$))
          );end if
          (setq BlockCounter (+ BlockCounter 1))
        ) ; end while
      );end progn
    );end if

    acount
  )
;;End Blocks
;;;;;;;;;;;;;;;;;;;;
  (defun updateattribvalues (EntType ent1 entlist1 acount Find$ Replace$ / )
    (setq EntName^ ent1
          EntList@ entlist1
          EntType$ EntType
          Text$ (cdr (assoc 1 EntList@))
    );setq
    (if (= EntType$ "INSERT")
      (if (assoc 66 EntList@)
        (progn
          (while (/= (cdr (assoc 0 EntList@)) "SEQEND")
            (setq EntList@ (entget EntName^))
            (if (= (cdr (assoc 0 EntList@)) "ATTRIB")
              (progn
                (setq Text$ (cdr (assoc 1 EntList@)))
                (if (wcmatch Text$ (strcat "*" Find$ "*"))
                  (progn
                    (setq FoundReplaced (FindReplace Text$ Find$ Replace$))
                    (setq ReplaceWith$ (nth 0 FoundReplaced))
                    (setq acount (+ acount (nth 1 FoundReplaced)))
                    (entmod (subst (cons 1 ReplaceWith$) (assoc 1 EntList@) EntList@))
                    (entupd EntName^)
                  );progn
                );if
              );progn
            );end if attrib
            (setq EntName^ (entnext EntName^))
          );while
        );progn
      );if
    );if
    acount
  ) ;end defun
;;;;;;;;;;;;;;;;;;;;
  (defun updatetext (EntType ent1 entlist1 acount Find$ Replace$ / entcodes1 FoundReplaced NewTxt)
    (progn
      (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text.
      (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string
        (if (= text01 nil)
          ()
          (progn
            (setq FoundReplaced (FindReplace text01 Find$ Replace$))
            (setq NewTxt (nth 0 FoundReplaced))
            (setq acount (+ acount (nth 1 FoundReplaced)))
            (addinnewtext NewTxt entlist1 ent1)
        )) ;end progn, end if
      ) ; end progn
    acount
  )
;;;;;;;;;;;;;;;;;;;;
  (defun UpdateTable ( EntType ent1 entlist1 acount Find$ Replace$ / text01 Newentlist1 counter)
    (setq counter 0)
    (setq Newentlist1 '())
    (while (< counter (length entlist1))
      (if (or (= (nth 0 (nth counter entlist1)) 1)(= (nth 0 (nth counter entlist1)) 302) )
        (progn
          (setq text01 (cdr (nth counter entlist1)))
          (setq FoundReplaced (FindReplace text01 Find$ Replace$))
          (setq NewTxt (nth 0 FoundReplaced))
          (setq acount (+ acount (nth 1 FoundReplaced)))
          (setq text01 NewTxt)
          (setq Newentlist1 (append Newentlist1 (list (cons (nth 0 (nth counter entlist1)) text01))))
        ) ;end progn
        (setq Newentlist1 (append Newentlist1 (list (nth counter entlist1)))) ;;ignore entity item
      ) ;end if
      (setq counter (+ counter 1))
    ) ;end while
    (setq entlist1 Newentlist1)
    (entmod entlist1)
    (entupd ent1)
    acount
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;end subroutines 'findreplace'
  (setq acount 0)
  (setq acounter 0)
  (command "UNDO" "BEGIN")
  (setq SS (ssget "x" (list '(-4 . "<AND")'(-4 . "<OR")'(0 . "*TEXT")'(0 . "INSERT")'(0 . "ATTDEF")'(0 . "ATTRIB")'(0 . "DIMENSION")'(0 . "*LEADER")'(0 . "POSITIONMARKER")'(0 . "*TABLE")'(-4 . "OR>")(cons 410 (getvar "CTAB"))'(-4 . "AND>"))))

  (while (< acounter (sslength SS))
    (setq ent1 (ssname SS acounter))
    (setq entlist1 (entget ent1))
    (setq EntType (cdr (assoc 0 entlist1)) )
    (setq Text$ (cdr (assoc 1 entlist1)) )  ;;change this line to get all texts inc. long texts etc.

;;Changes Attribute Values - In Blocks
  (setq acount (updateattribvalues EntType ent1 entlist1 acount Find$ Replace$))

;;Changes Block Texts
  (if (= EntType "INSERT")
    (setq acount (updateblock EntType ent1 entlist1 acount Find$ Replace$))
  );end if

;;Changes Texts
  (if (or (= EntType "MTEXT")(= EntType "TEXT")
          (= EntType "MULTILEADER")
          (= EntType "POSITIONMARKER")
      )
    (setq acount (updatetext EntType ent1 entlist1 acount Find$ Replace$))
  ); end if

  (if (or (= EntType "DIMENSION") )
    (if (= (cdr (assoc 1 entlist1)) "") ;;if has text over ride
      ()
      (setq acount (updatetext EntType ent1 entlist1 acount Find$ Replace$)) ;;same as text -if- ent code 4 used
    )
  ); end if

  (if (or (= EntType "ATTDEF")(= EntType "ATTRIB") )
    (progn
      (setq ent2 (entget ent1))
      (setq AttText (cdr (assoc 2 ent2)))
      (setq FoundReplaced (FindReplace AttText Find$ Replace$))
      (setq NewTxt (nth 0 FoundReplaced))
      (setq acount (+ acount (nth 1 FoundReplaced)))
      (setq newval Replace$)
      (entmod (subst (cons 2 NewTxt) (assoc 2 ent2) ent2))
      (entupd ent1)
    );end progn
  ); end if

  (if (= EntType "ACAD_TABLE")
    (setq acount (UpdateTable EntType ent1 entlist1 acount Find$ Replace$))
  );end if

    (setq acounter (+ 1 acounter))
  ) ; end while

  (command "UNDO" "END")
  (command "REGEN")
  acount
);defun FindReplaceNew

 

Posted

I'm not sure if this one works or if it is a work in progress - a stripped down version of my batch LISP. Command BasicBatchLisp

 

(defun c:za() (command "zoom" "a" "zoom" ".95x")(princ));;Zoom all, then zooms out 0.95x
(vl-load-com)
;;------------------------=={ Get Files Dialog }==----------------------;;
;;                                                                      ;;
;;  An analog of the 'getfiled' function for multiple file selection.   ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2012  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Arguments:                                                          ;;
;;  msg - [str/nil] Dialog box label; 'Select Files' if nil or "".      ;;
;;  def - [str/nil] Default directory; dwgprefix if nil or "".          ;;
;;  ext - [str/nil] File extension filter (e.g. "dwg;lsp"); "*" if nil  ;;
;;----------------------------------------------------------------------;;
;;  Returns:  List of selected files, else nil                          ;;
;;----------------------------------------------------------------------;;
;;  Version 1.6    -    2016-03-21                                      ;;
;;----------------------------------------------------------------------;;
(defun LM:getfiles ( msg def ext / *error* dch dcl des dir dirdata lst rtn )

    (defun *error* ( msg )
        (if (= 'file (type des))
            (close des)
        )
        (if (and (= 'int (type dch)) (< 0 dch))
            (unload_dialog dch)
        )
        (if (and (= 'str (type dcl)) (findfile dcl))
            (vl-file-delete dcl)
        )
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )    
    
    (if
        (and
            (setq dcl (vl-filename-mktemp nil nil ".dcl"))
            (setq des (open dcl "w"))
            (progn
                (foreach x
                   '(
                        "lst : list_box"
                        "{"
                        "    width = 40.0;"
                        "    height = 20.0;"
                        "    fixed_width = true;"
                        "    fixed_height = true;"
                        "    alignment = centered;"
                        "    multiple_select = true;"
                        "}"
                        "but : button"
                        "{"
                        "    width = 20.0;"
                        "    height = 1.8;"
                        "    fixed_width = true;"
                        "    fixed_height = true;"
                        "    alignment = centered;"
                        "}"
                        "getfiles : dialog"
                        "{"
                        "    key = \"title\"; spacer;"
                        "    : row"
                        "    {"
                        "        alignment = centered;"
                        "        : edit_box { key = \"dir\"; label = \"Folder:\"; }"
                        "        : button"
                        "        {"
                        "            key = \"brw\";"
                        "            label = \"Browse\";"
                        "            fixed_width = true;"
                        "        }"
                        "    }"
                        "    spacer;"
                        "    : row"
                        "    {"
                        "        : column"
                        "        {"
                        "            : lst { key = \"box1\"; }"
                        "            : but { key = \"add\" ; label = \"Add Files\"; }"
                        "        }"
                        "        : column {"
                        "            : lst { key = \"box2\"; }"
                        "            : but { key = \"del\" ; label = \"Remove Files\"; }"
                        "        }"
                        "    }"
                        "    spacer; ok_cancel;"
                        "}"
                    )
                    (write-line x des)
                )
                (setq des (close des))
                (< 0 (setq dch (load_dialog dcl)))
            )
            (new_dialog "getfiles" dch)
        )
        (progn
            (setq ext (if (= 'str (type ext)) (LM:getfiles:str->lst (strcase ext) ";") '("*")))
            (set_tile "title" (if (member msg '(nil "")) "Select Files" msg))
            (set_tile "dir"
                (setq dir
                    (LM:getfiles:fixdir
                        (if (or (member def '(nil "")) (not (vl-file-directory-p (LM:getfiles:fixdir def))))
                            (getvar 'dwgprefix)
                            def
                        )
                    )
                )
            )
            (setq lst (LM:getfiles:updatefilelist dir ext nil))
            (mode_tile "add" 1)
            (mode_tile "del" 1)

            (action_tile "brw"
                (vl-prin1-to-string
                   '(if (setq tmp (LM:getfiles:browseforfolder "" nil 512))
                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir tmp)) ext rtn)
                              rtn (LM:getfiles:updateselected dir rtn)
                        )                              
                    )
                )
            )

            (action_tile "dir"
                (vl-prin1-to-string
                   '(if (= 1 $reason)
                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir (LM:getfiles:fixdir $value))) ext rtn)
                              rtn (LM:getfiles:updateselected dir rtn)
                        )
                    )
                )
            )

            (action_tile "box1"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm tmp )
                            (if (setq itm (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" $value ")"))))
                                (if (= 4 $reason)
                                    (cond
                                        (   (equal '("..") itm)
                                            (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir (LM:getfiles:updir dir))) ext rtn)
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                            )
                                        )
                                        (   (vl-file-directory-p (setq tmp (LM:getfiles:checkredirect (strcat dir "\\" (car itm)))))
                                            (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir tmp)) ext rtn)
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                            )
                                        )
                                        (   (setq rtn (LM:getfiles:sort (append rtn (mapcar '(lambda ( x ) (strcat dir "\\" x)) itm)))
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                                  lst (LM:getfiles:updatefilelist dir ext rtn)
                                            )
                                        )
                                    )
                                    (if (vl-every '(lambda ( x ) (vl-file-directory-p (strcat dir "\\" x))) itm)
                                        (mode_tile "add" 1)
                                        (mode_tile "add" 0)
                                    )
                                )
                            )
                        )
                    )
                )
            )

            (action_tile "box2"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if (setq itm (mapcar '(lambda ( n ) (nth n rtn)) (read (strcat "(" $value ")"))))
                                (if (= 4 $reason)
                                    (setq rtn (LM:getfiles:updateselected dir (vl-remove (car itm) rtn))
                                          lst (LM:getfiles:updatefilelist dir ext rtn)
                                    )
                                    (mode_tile "del" 0)
                                )
                            )
                        )
                    )
                )
            )

            (action_tile "add"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if
                                (setq itm
                                    (vl-remove-if 'vl-file-directory-p
                                        (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" (get_tile "box1") ")")))
                                    )
                                )
                                (setq rtn (LM:getfiles:sort (append rtn (mapcar '(lambda ( x ) (strcat dir "\\" x)) itm)))
                                      rtn (LM:getfiles:updateselected dir rtn)
                                      lst (LM:getfiles:updatefilelist dir ext rtn)
                                )
                            )
                            (mode_tile "add" 1)
                            (mode_tile "del" 1)
                        )
                    )
                )
            )

            (action_tile "del"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if (setq itm (read (strcat "(" (get_tile "box2") ")")))
                                (setq rtn (LM:getfiles:updateselected dir (LM:getfiles:removeitems itm rtn))
                                      lst (LM:getfiles:updatefilelist dir ext rtn)
                                )
                            )
                            (mode_tile "add" 1)
                            (mode_tile "del" 1)
                        )
                    )
                )
            )
         
            (if (zerop (start_dialog))
                (setq rtn nil)
            )
        )
    )
    (*error* nil)
    rtn
)
(defun LM:getfiles:listbox ( key lst )
    (start_list key)
    (foreach x lst (add_list x))
    (end_list)
    lst
)
(defun LM:getfiles:listfiles ( dir ext lst )
    (vl-remove-if '(lambda ( x ) (member (strcat dir "\\" x) lst))
        (cond
            (   (cdr (assoc dir dirdata)))
            (   (cdar
                    (setq dirdata
                        (cons
                            (cons dir
                                (append
                                    (LM:getfiles:sortlist (vl-remove "." (vl-directory-files dir nil -1)))
                                    (LM:getfiles:sort
                                        (if (member ext '(("") ("*")))
                                            (vl-directory-files dir nil 1)
                                            (vl-remove-if-not
                                                (function
                                                    (lambda ( x / e )
                                                        (and
                                                            (setq e (vl-filename-extension x))
                                                            (setq e (strcase (substr e 2)))
                                                            (vl-some '(lambda ( w ) (wcmatch e w)) ext)
                                                        )
                                                    )
                                                )
                                                (vl-directory-files dir nil 1)
                                            )
                                        )
                                    )
                                )
                            )
                            dirdata
                        )
                    )
                )
            )
        )
    )
)
(defun LM:getfiles:checkredirect ( dir / itm pos )
    (cond
        (   (vl-directory-files dir) dir)
        (   (and
                (=  (strcase (getenv "UserProfile"))
                    (strcase (substr dir 1 (setq pos (vl-string-position 92 dir nil t))))
                )
                (setq itm
                    (cdr
                        (assoc (substr (strcase dir t) (+ pos 2))
                           '(
                                ("my documents" . "Documents")
                                ("my pictures"  . "Pictures")
                                ("my videos"    . "Videos")
                                ("my music"     . "Music")
                            )
                        )
                    )
                )
                (vl-file-directory-p (setq itm (strcat (substr dir 1 pos) "\\" itm)))
            )
            itm
        )
        (   dir   )
    )
)
(defun LM:getfiles:sort ( lst )
    (apply 'append
        (mapcar 'LM:getfiles:sortlist
            (vl-sort
                (LM:getfiles:groupbyfunction lst
                    (lambda ( a b / x y )
                        (and
                            (setq x (vl-filename-extension a))
                            (setq y (vl-filename-extension b))
                            (= (strcase x) (strcase y))
                        )
                    )
                )
                (function
                    (lambda ( a b / x y )
                        (and
                            (setq x (vl-filename-extension (car a)))
                            (setq y (vl-filename-extension (car b)))
                            (< (strcase x) (strcase y))
                        )
                    )
                )
            )
        )
    )
)
(defun LM:getfiles:sortlist ( lst )
    (mapcar (function (lambda ( n ) (nth n lst)))
        (vl-sort-i (mapcar 'LM:getfiles:splitstring lst)
            (function
                (lambda ( a b / x y )
                    (while
                        (and
                            (setq x (car a))
                            (setq y (car b))
                            (= x y)
                        )
                        (setq a (cdr a)
                              b (cdr b)
                        )
                    )
                    (cond
                        (   (null x) b)
                        (   (null y) nil)
                        (   (and (numberp x) (numberp y)) (< x y))
                        (   (numberp x))
                        (   (numberp y) nil)
                        (   (< x y))
                    )
                )
            )
        )
    )
)
(defun LM:getfiles:groupbyfunction ( lst fun / tmp1 tmp2 x1 )
    (if (setq x1 (car lst))
        (progn
            (foreach x2 (cdr lst)
                (if (fun x1 x2)
                    (setq tmp1 (cons x2 tmp1))
                    (setq tmp2 (cons x2 tmp2))
                )
            )
            (cons (cons x1 (reverse tmp1)) (LM:getfiles:groupbyfunction (reverse tmp2) fun))
        )
    )
)
(defun LM:getfiles:splitstring ( str )
    (
        (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (apply 'append
                            (mapcar
                                (function
                                    (lambda ( a b c )
                                        (cond
                                            (   (member b '(45 46 92))
                                                (list 32)
                                            )
                                            (   (< 47 b 58)
                                                (list b)
                                            )
                                            (   (list 32 34 b 34 32))
                                        )
                                    )
                                )
                                (cons nil l) l (append (cdr l) '(( )))
                            )
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list (strcase str))
    )
)
(defun LM:getfiles:browseforfolder ( msg dir flg / err fld pth shl slf )
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "shell.application")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg flg dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              pth (LM:getfiles:fixdir (vlax-get-property slf 'path))
                        )
                    )
                )
            )
        )
    )
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        pth
    )
)
(defun LM:getfiles:full->relative ( dir path / p q )
    (setq dir (vl-string-right-trim "\\" dir))
    (cond
        (   (and
                (setq p (vl-string-position 58  dir))
                (setq q (vl-string-position 58 path))
                (/= (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
            )
            path
        )
        (   (and
                (setq p (vl-string-position 92  dir))
                (setq q (vl-string-position 92 path))
                (= (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
            )
            (LM:getfiles:full->relative (substr dir (+ 2 p)) (substr path (+ 2 q)))
        )
        (   (and
                (setq q (vl-string-position 92 path))
                (= (strcase dir) (strcase (substr path 1 q)))
            )
            (strcat ".\\" (substr path (+ 2 q)))
        )
        (   (= "" dir)
            path
        )
        (   (setq p (vl-string-position 92 dir))
            (LM:getfiles:full->relative (substr dir (+ 2 p)) (strcat "..\\" path))
        )
        (   (LM:getfiles:full->relative "" (strcat "..\\" path)))
    )
)
(defun LM:getfiles:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:getfiles:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)
(defun LM:getfiles:updatefilelist ( dir ext lst )
    (LM:getfiles:listbox "box1" (LM:getfiles:listfiles dir ext lst))
)
(defun LM:getfiles:updateselected ( dir lst )
    (LM:getfiles:listbox "box2" (mapcar '(lambda ( x ) (LM:getfiles:full->relative dir x)) lst))
    lst
)
(defun LM:getfiles:updir ( dir )
    (substr dir 1 (vl-string-position 92 dir nil t))
)
(defun LM:getfiles:fixdir ( dir )
    (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir))
)
(defun LM:getfiles:removeitems ( itm lst / idx )
    (setq idx -1)
    (vl-remove-if '(lambda ( x ) (member (setq idx (1+ idx)) itm)) lst)
)





(defun c:BasicBatchLisp ( / currentdrawing ThisDrawing batchdirectory batchfileslist l CommandsList
                            NextCommand acount acounter tempscript f)

;; Get Current Drawing
  (setq currentdrawing (strcat (getvar "dwgprefix")(getvar "dwgname"))) ;; get this drawing filepath abd name

;; Make Commands List
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Commands List Notes:
;;- write commands as if you were writing them in a LISP excluding start and end bracket ( )
;;  for example to draw a line (example usng an AutoCAD command example) 
;;  command "line" "0,0" "10,10" ""
;;  (no brackets)
;;  or for a LISP
;;  c:za
;;  remembering for LISPs to include the 'c:'
;;
;;- Note that in this the LISP routines have to be preloaded as the drawing opens, 
;;  I haven't added function to serch out and load LISPs on demand.
;;  There is no functionality in this to determine if commands are LISP, basic CAD
;;  commands or others
;;
;;- Commands can also be LISP commands and can even make up a LISP 'on thr fly' in each
;;c drawing if required which takes some thinking about
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq CommandsList (list) )                                           ;; a blank list
  (while (/= (setq NextCommand (getstring "Enter Next Command or ENTER to exit" T)) "")
    (setq CommandsList (append CommandsList (list NextCommand)))        ;; complete list with entered commands
  )

;; Run on this drawing
  (princ "\n")
  (initget "Y N YES NO Exit")                                           ;; limit options to yes / no / y / n
  (setq ThisDrawing (substr (strcase (getkword "Run on this drawing? [ Y N ]")) 1 1 )) ;; to get just Y or N

;;get files list from folder
  (setq batchfileslist (LM:getfiles "Choose Files" "" "dwg"))           ;; Fun LM:getfiles LISP

;;Create and open script file
  (setq acount 0) ;; a counter                                          ;; set a counter to 0 (in case used elsewhere)
  (setq tempscript (strcat (getvar "TEMPPREFIX") "tempbatchscrpt.scr")) ;; make temp script file (a text file)
  (setq f (open tempscript "w")) ;;open file                            ;; open script file to edit / write to

  (if (= ThisDrawing "Y")                                               ;; if modifying current drawing
    (progn                                                              ;; write these parts to script file
      (setq acounter 0)
      (while (< acounter (length CommandsList))
        (progn
          (write-line (strcat "(" (nth acounter CommandsList) ")" ) f)
          (setq acounter (+ acounter 1))
        ) ;;end progn
      ) ;;end for each x
    )
  )

 (foreach n batchfileslist                                              ;; loop through files list from above
   (progn
     (if (= (nth acount batchfileslist) currentdrawing)                 ;; exclude current drawing if it is in files list
       ()
       (progn                                                                 ;; script:
         (write-line (strcat "_.OPEN \"" (nth acount batchfileslist) "\"") f) ;; script to open the drawing
         (setq acounter 0)
         (while (< acounter (length CommandsList))                            ;; loop through commands list
          (progn
             (write-line (strcat "(" (nth acounter CommandsList) ")" ) f)     ;; write command to script file
             (setq acounter (+ acounter 1))
           ) ;;end progn
         ) ;;end for each x

        (write-line "(vla-save (vla-get-ActiveDocument (vlax-get-Acad-Object)))" f)  ;;script save command
        (write-line "(if (= dbmod 0)(command \".close\"))" f) ;;close the drawing    ;;script close drawing if no mods
        (write-line "(if (/= dbmod 0)(command \".close\" \"y\"))" f) ;;close the drawing  ;; or close drawing if mods
      ) ;;end progn
    ) ;;end if
   ) ;;end progn
   (setq acount (+ 1 acount))
 )  ;;end for each n
  (close f)

  (command "_.SCRIPT" tempscript) ;;run script
)

 

Posted

Hi, tried that and didn't work for me, did you say the command to get it on autocad is FindReplaceNew ? I rarely do lsp's so the command is probably in the file itself. I loaded it and seemed to upload. Sorry for the silly questions.

Posted

Trying to work out what the problem is, did you try this as a stand alone function on a single drawing? The function doesn't have a 'C:' in front of the name so have to run it with the brackets (FindReplaceNew old_text new_text)

 

I have taken this from my LISP library so it is very possible that I didn't include all that is necessary for it to work,

 

Below is another little function that asks the user to input the old and new text, load this one and the first I posted, the command for this is txtfindreplace - it should then run the other code.

 

(defun c:txtFindReplace( / old_text new_text)
  (setq old_text (getstring T "OLD Text to replace (replace in this model/paper space and text case as entered): "))
  (setq new_text (getstring T "NEW Text: "))
  (FindReplaceNew old_text new_text)
  (princ)
)

 

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