Can 发表于 2022-7-5 15:42:32

多文本查找并替换为l

你好
 
 
我需要一个Lisp程序。该程序首先应在图形中找到EXCEL的A列中写入的文本,然后应将其替换为EXCEL的b列中写入的文本。
 
 
谢谢

rlx 发表于 2022-7-5 15:50:18

不知道excel部分,但许多人认为这是最好的:http://www.lee-mac.com/bfind.html

BIGAL 发表于 2022-7-5 15:51:15

我在谷歌上搜索了一下,第一个帖子提供了一个解决方案。您只需将这两列作为csv文件写入,然后使用简单的csv->列表,只需重复读取代码中的每一行和简单的defun。
 
看看这里的cadtutor
 
这个愚蠢的问题,你有没有试着找到,如果不是很多的文字相当快。
 
如果你有很多DWG,那么李的版本就是最好的选择。它可以考虑csv文件,比从excel中读取更简单。李,也许有一个额外的选择?

Can 发表于 2022-7-5 15:59:11

谢谢你的建议。
 
 
我想知道是否有更实际的方法来实现这一点。随附文件可以使我的目标更加明确。请让我知道,如果你有其他想法后,检查这个屏幕截图。
 
 
提前感谢

测试1.dwg
Book1.xlsx

Can 发表于 2022-7-5 15:59:53

以获得更好的分辨率。

marko_ribar 发表于 2022-7-5 16:08:01

嗨,可以试试这个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 - Dialog label
   ;; lst - List of strings to display
   ;; bit - 1=allow multiple; 2=return indexes
   ;; Returns: 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。

Can 发表于 2022-7-5 16:10:22

太棒了
 
 
它起到了很好的作用。
 
 
非常感谢您的努力和帮助。

Grrr 发表于 2022-7-5 16:13:23

有了assoc列表,编写代码就容易多了,但可能不那么方便用户:
 
(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

Can 发表于 2022-7-5 16:19:37

实际上我有一个小问题。
 
 
我有一个列表,其中包括一些要跳过的数据,因为它们在图形中不存在。我猜您提供的代码在这种情况下不起作用。
 
 
有没有可能修改代码,使其能够找到并替换现有的代码?当然,由于这个原因,我认为它无法取代。
 
 
提前谢谢。
TESTBook1.xlsx
图纸2.dwg

marko_ribar 发表于 2022-7-5 16:24:21

对已发布代码的小更改。。。
添加了条件(如果s(foreach txt。。。
 
请立即尝试并通知我们。。。
页: [1] 2
查看完整版本: 多文本查找并替换为l