Multi Text Find&Replace with lisp

December 22, 2017

Hello,

I need a Lisp Program. This program firstly should find the texts writen in the A column of the excell in A drawing and secondly it should replace them with the texts writen in the b column of the excell.

Thanks

December 22, 2017

don't know about the excel part but many people think this one is the best : http://www.lee-mac.com/bfind.html

December 22, 2017

I did a Google and the 1st post provided a solution. You would just have to write the two columns as a csv file then use a simple csv -> list and just use a repeat reading each line and the simple defun that was in the code.

Look here at cadtutor

The dumb question did you try FIND if its not lots of text pretty quick.

Lee's version is the way to go if you have lots of dwgs. It could take into account a csv file, simpler than reading from excel. Maybe an extra option Lee ?

December 26, 2017

Thank you for your advices.

I wonder if there can be a more practical way to achieve this. Attached documents can make my aim more clear. Please let me know if you have another idea after checking this screenshot.

Thanks in advance

test1.dwg

Book1.xlsx

December 26, 2017

For better resolution.

December 26, 2017

Hi Can, try this lisp :

(defun c:multfindrepl-excel ( / excel fn excellst s )

 (defun excel ( ExcelFile$ / Cell->ColumnRow ColumnRow->Cell Alpha2Number Number2Alpha LM:listbox startcell endcell stc enc colrow *ExcelApp% Sheets@ SheetName$ CurRange c r Value Valuel Valuelst )

   (vl-load-com)

   ;-------------------------------------------------------------------------------
   ; Cell->ColumnRow - Returns a list of the Column and Row number
   ; Function By: Gilles Chanteau from Marseille, France
   ; Arguments: 1
   ;   Cell$ = Cell ID
   ; Syntax example: (Cell->ColumnRow "ABC987") = '(731 987)
   ;-------------------------------------------------------------------------------
   (defun Cell->ColumnRow (Cell$ / Column$ Char$ Row#)
     (setq Column$ "")
     (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91)
       (setq Column$ (strcat Column$ Char$)
             Cell$ (substr Cell$ 2)
       );setq
     );while
     (if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
       (list (Alpha2Number Column$) Row#)
       '(1 1);default to "A1" if there's a problem
     );if
   );defun Cell->ColumnRow
   ;-------------------------------------------------------------------------------
   ; ColumnRow->Cell - Returns Cell ID from list of the Column and Row number
   ; Function By: Marko Ribar from Belgrade, Serbia
   ; Arguments: 1
   ;   ColumnRow$ = list
   ; Syntax example: (ColumnRow->Cell '(731 987)) = "ABC987"
   ;-------------------------------------------------------------------------------
   (defun ColumnRow->Cell (Lst$ / Column$)
     (setq Column$ (Number2Alpha (car Lst$)))
     (strcat Column$ (itoa (cadr Lst$)))
   );defun ColumnRow->Cell
   ;-------------------------------------------------------------------------------
   ; Alpha2Number - Converts Alpha string into Number
   ; Function By: Gilles Chanteau from Marseille, France
   ; Arguments: 1
   ;   Str$ = String to convert
   ; Syntax example: (Alpha2Number "ABC") = 731
   ;-------------------------------------------------------------------------------
   (defun Alpha2Number (Str$ / Num#)
     (if (= 0 (setq Num# (strlen Str$)))
       0
       (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
          (Alpha2Number (substr Str$ 2))
       );+
     );if
   );defun Alpha2Number
   ;-------------------------------------------------------------------------------
   ; Number2Alpha - Converts Number into Alpha string
   ; Function By: Gilles Chanteau from Marseille, France
   ; Arguments: 1
   ;   Num# = Number to convert
   ; Syntax example: (Number2Alpha 731) = "ABC"
   ;-------------------------------------------------------------------------------
   (defun Number2Alpha (Num# / Val#)
     (if (< Num# 27)
       (chr (+ 64 Num#))
       (if (= 0 (setq Val# (rem Num# 26)))
         (strcat (Number2Alpha (1- (/ Num# 26))) "Z")
         (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
       );if
     );if
   );defun Number2Alpha

   ;; List Box  -  Lee Mac
   ;; Displays a DCL list box allowing the user to make a selection from the supplied data.
   ;; msg - [str] Dialog label
   ;; lst - [lst] List of strings to display
   ;; bit - [int] 1=allow multiple; 2=return indexes
   ;; Returns: [lst] List of selected items/indexes, else nil
    
   (defun LM:listbox ( msg lst bit / dch des tmp rtn )
       (cond
           (   (not
                   (and
                       (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                       (setq des (open tmp "w"))
                       (write-line
                           (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
                               (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
                           )
                           des
                       )
                       (not (close des))
                       (< 0 (setq dch (load_dialog tmp)))
                       (new_dialog "listbox" dch)
                   )
               )
               (prompt "\nError Loading List Box Dialog.")
           )
           (   t     
               (start_list "list")
               (foreach itm lst (add_list itm))
               (end_list)
               (setq rtn (set_tile "list" "0"))
               (action_tile "list" "(setq rtn $value)")
               (setq rtn
                   (if (= 1 (start_dialog))
                       (if (= 2 (logand 2 bit))
                           (read (strcat "(" rtn ")"))
                           (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                       )
                   )
               )
           )
       )
       (if (< 0 dch)
           (unload_dialog dch)
       )
       (if (and tmp (setq tmp (findfile tmp)))
           (vl-file-delete tmp)
       )
       rtn
   )

   (setq ExcelFile$ (findfile ExcelFile$))
   (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
   ;;;(vlax-put-property *ExcelApp% "Visible" :vlax-true)
   (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
   (vlax-for Sheet$ (vlax-get-property *ExcelApp% "Sheets")
     (setq Sheets@ (append Sheets@ (list (vlax-get-property Sheet$ "Name"))))
   )
   (setq SheetName$ (car (LM:Listbox "Select Sheet to process..." Sheets@ 0)))
   (vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
     (if (= (vlax-get-property Worksheet "Name") SheetName$)
       (vlax-invoke-method Worksheet "Activate")
     )
   )
   (setq startcell (strcase (getstring "\nSpecify start cell of excel table - upper left cell : ")))
   (setq endcell (strcase (getstring "\nSpecify end cell of excel table - lower right cell : ")))
   (setq stc (Cell->ColumnRow startcell))
   (setq enc (Cell->ColumnRow endcell))
   (setq colrow (mapcar '- enc stc))
   (setq r (1- (cadr stc)))
   (repeat (1+ (cadr colrow))
     (setq c (1- (car stc)) r (1+ r))
     (repeat (1+ (car colrow))
       (setq CurRange (vlax-get-property (vlax-get-property *ExcelApp% "ActiveSheet") "Range" (ColumnRow->Cell (list (setq c (1+ c)) r))))
       (setq Value (vlax-get CurRange 'Text))
       (setq Valuel (cons Value Valuel))
     )
     (setq Valuel (reverse Valuel))
     (setq Valuelst (cons Valuel Valuelst) Valuel nil)
   )
   (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
   (vlax-invoke-method *ExcelApp% 'Quit)
   (vlax-release-object *ExcelApp%)(gc)
   (reverse Valuelst)
 )

 (setq fn (getfiled "Select Excel file to process..." "\\" "xlsx;xls;csv;*" 16))
 (setq excellst (excel fn))
 (foreach r excellst
   (setq s (ssget "_X" (list '(0 . "TEXT") (cons 1 (car r)))))
   (if s
     (foreach txt (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (entupd (cdr (assoc -1 (entmod (subst (cons 1 (cadr r)) (assoc 1 (entget txt)) (entget txt))))))
     )
   )
 )
 (princ)
)

M.R.

Edited December 26, 2017 by marko_ribar
added condition (if s (foreach txt ...

December 26, 2017

Great!

It worked like a charm.

Thank you very much for your kind effort and help.

December 26, 2017

With assoc list its just alot easier to code it, but perhaps not so user friendly:

(defun C:test ( / _mapss old new SS )
 (defun _mapss ( f s i / e ) (if (setq e (ssname s (setq i (1+ i)))) (cons (f e) (_mapss f s i))))
 (foreach x
   '(
     ("OldText1" "NewText1")
     ("OldText2" "NewText2")
     ("OldText3" "NewText3")
     ; ...
   )
   (and
     (vl-every 'set '(old new) x)
     (setq SS (ssget "_X" (list '(0 . "TEXT") (setq old (cons 1 old)))))
     (_mapss (lambda (e / enx) (setq enx (entget e)) (entmod (subst (cons 1 new) old enx))) SS -1)
   ); and
 ); foreach
 (princ)
); defun

December 26, 2017

Actually I have a small problem.

I have a list which includes some data to be skipped because they do not exist in the drawing. I guess the code you supplied do not work in this case.

Would it be possible to modify the code so that it can find and replace the only the existing ones? Of couse I assume that It could not replace for this reason.

Thanks in advance.

TESTBook1.xlsx

Drawing2.dwg

December 26, 2017

small change to posted code...

added condition (if s (foreach txt ...

try it now and inform us...

December 26, 2017

it worked exactly how I need,

Thank you very much again

December 26, 2017

How about this one:


(defun C:test ( / L )
 (cond
   ( (not c:BFind) (alert "\nPlease download Lee Mac's Batch Find v2-0 rotuine.") )
   ( (not (setq L (xl_TwoColumnsPrompt))) "c'mon you know what you (not) did" )
   ( (not (setq L (vl-remove-if (function (lambda (x) (= "" (car x) (cdr x)))) L))) (prompt "\nInvalid cells in first and second column.") )
   (
     (defun _GetSavePath ( / tmp ) ; Taken from BFindV2-0.lsp
       (cond      
         ( (setq tmp (getvar 'ROAMABLEROOTPREFIX))
           (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" tmp)) "\\Support")
         )
         ( (setq tmp (findfile "ACAD.pat"))
           (vl-string-right-trim "\\" (vl-string-translate "/" "\\" (vl-filename-directory tmp)))
         )
         ( (vl-string-right-trim "\\" (vl-filename-directory (vl-filename-mktemp))) )
       )
     ); defun _GetSavePath
     (Bfind2-0:BatchDefaultFindReplaceList (strcat (_GetSavePath) "\\LMAC_BFind_V" "2-0" ".cfg") L)
     (c:BFind)
   )
 ); cond
 (princ)
); defun


(defun xl_TwoColumnsPrompt ( / *error* xlapp xls msg xlwbs xlwbk xlsht xlrng xlcls xlcol L )
 
 (defun *error* ( m )
   (and (eq 'VLA-OBJECT (type xlwbk)) (vl-catch-all-apply 'vlax-invoke-method (list xlwbk 'close :vlax-false)) )
   (and xlapp (vl-catch-all-apply 'vlax-invoke-method (list xlapp 'quit)))
   (foreach o (reverse (list xlapp xls msg xlwbs xlwbk xlsht xlrng xlcls xlcol L)) (and (eq 'VLA-OBJECT (type o)) (vl-catch-all-apply 'vlax-release-object (list o))) )
   (gc) (and m (princ m)) (princ)
 ); defun *error*
 
 (cond 
   ( (not (setq xlapp (vlax-get-or-create-object "Excel.Application"))) (prompt "\nUnable to interfere with Excel application.") )
   ( (not (setq xls (getfiled "Specify xlsx file" (strcat (getenv "userprofile") "\\Desktop\\") "xlsx" 16))) )
   (
     (vl-catch-all-error-p
       (setq msg
         (vl-catch-all-apply
           (function
             (lambda ( / GetCellText i )
               (setq GetCellText (lambda ( xlcls row col ) (vlax-variant-value (vlax-get-property (vlax-variant-value (vlax-get-property xlcls 'item row col)) 'Text)) ))
               (vlax-put-property xlapp 'Visible :vlax-false)
               (setq xlwbs (vlax-get-property xlapp 'Workbooks))
               (setq xlwbk (vlax-invoke-method xlwbs 'Open xls))
               (setq xlsht (vlax-get-property  xlapp 'ActiveSheet))
               (setq xlrng (vlax-get-property  xlsht 'UsedRange))
               (setq xlcls (vlax-get-property  xlrng 'Cells))
               (repeat (setq i (vlax-get-property (setq xlcol (vlax-get-property  xlrng 'Rows)) 'Count))
                 (setq L (cons (cons (GetCellText xlcls i 1) (GetCellText xlcls i 2)) L))
                 (setq i (1- i))
               ); repeat
             )
           )
         )
       )
     )
     (prompt (strcat "\nError: "  (vl-catch-all-error-message msg)))
   )
 ); cond
 (*error* nil) L ; NOTE: L is based on the UsedRange, so there might be empty cells like: ("" . ""), these are retained in the list due the posibility to use the cell's positions
); defun xl_TwoColumnsPrompt


; fnm - (strcat (_GetSavePath) "\\LMAC_BFind_V" "2-0" ".cfg"), (_GetSavePath) can be found inside of BFindV2-0.lsp, "2-0" is the Bfind version
; L - dxf assoc list of strings: '(("FindThis" . "ReplaceWithThis") ...)
; example: (Bfind2-0:BatchDefaultFindReplaceList (strcat (_GetSavePath) "\\LMAC_BFind_V" "2-0" ".cfg") '(("1" . "2")("3" . "4")) )
(defun Bfind2-0:BatchDefaultFindReplaceList ( fnm L / stringp *error* des row tmp r )
 (setq stringp (lambda (x) (eq 'STR (type x))))
 (defun *error* ( m ) (and (eq 'FILE (type des)) (close des)) (and m (princ m)) )
 (cond 
   ( (not (stringp fnm)) )
   ( (or (not (vl-consp L)) (not (vl-every (function (lambda (x) (and (vl-consp x) (stringp (car x)) (stringp (cdr x))))) L))) )
   ( (findfile fnm) 
     (setq des (open fnm "R")) (while (setq row (read-line des)) (setq tmp (cons row tmp))) (setq tmp (reverse tmp)) (close des)
     (setq des (open fnm "W")) (foreach x (cons (vl-prin1-to-string L) (cdr tmp)) (write-line x des))
     (setq r t)
   )
   ( (apply 'vl-filename-mktemp (fnsplitl fnm)) (setq des (open fnm "W"))
     (foreach x (list L (vl-string-right-trim "\\" (getvar 'dwgprefix)) "0" "0" "1" (+ 1 8 16 32 64 128 256 512) "0" "0") ; these are the defaults from BFindV2-0.lsp
       (write-line (vl-prin1-to-string x) des)
     ); foreach
     (setq r t)
   )      
 ); cond
 (*error* nil) r
); defun Bfind2-0:BatchDefaultFindReplaceList

But it requires Lee Mac's Batch Find & Replace Text

December 27, 2017

Nice one guys Marko & Grrr it goes to show the overhead required in what sounds like a simple request just change some text.

December 27, 2017

@Grrr,

Thank for your code as well, it has some additional capabilities, higher than I expected and needed.

December 27, 2017

Nice one guys Marko & Grrr it goes to show the overhead required in what sounds like a simple request just change some text.

Thanks, BIGAL!

@Grrr,

Thank for your code as well, it has some additional capabilities, higher than I expected and needed.

Thanks, however all that functionality comes from Lee Mac's routine - I just figured out how to batch a predefined Find/Replace list in there (well and the excel part).

Sign In

Multi Text Find&Replace with lisp

Recommended Posts

Can

rlx

BIGAL

Can

Can

marko_ribar

Can

Grrr

Can

marko_ribar

Can

Grrr

BIGAL

Can

Grrr

Join the conversation

Tutorials

Forums

Activity