[编程交流] 多文本查找并替换为l

(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)
)

(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