多文本查找并替换为l
你好我需要一个Lisp程序。该程序首先应在图形中找到EXCEL的A列中写入的文本,然后应将其替换为EXCEL的b列中写入的文本。
谢谢 不知道excel部分,但许多人认为这是最好的:http://www.lee-mac.com/bfind.html 我在谷歌上搜索了一下,第一个帖子提供了一个解决方案。您只需将这两列作为csv文件写入,然后使用简单的csv->列表,只需重复读取代码中的每一行和简单的defun。
看看这里的cadtutor
这个愚蠢的问题,你有没有试着找到,如果不是很多的文字相当快。
如果你有很多DWG,那么李的版本就是最好的选择。它可以考虑csv文件,比从excel中读取更简单。李,也许有一个额外的选择? 谢谢你的建议。
我想知道是否有更实际的方法来实现这一点。随附文件可以使我的目标更加明确。请让我知道,如果你有其他想法后,检查这个屏幕截图。
提前感谢
测试1.dwg
Book1.xlsx 以获得更好的分辨率。
嗨,可以试试这个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。 太棒了
它起到了很好的作用。
非常感谢您的努力和帮助。 有了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 实际上我有一个小问题。
我有一个列表,其中包括一些要跳过的数据,因为它们在图形中不存在。我猜您提供的代码在这种情况下不起作用。
有没有可能修改代码,使其能够找到并替换现有的代码?当然,由于这个原因,我认为它无法取代。
提前谢谢。
TESTBook1.xlsx
图纸2.dwg 对已发布代码的小更改。。。
添加了条件(如果s(foreach txt。。。
请立即尝试并通知我们。。。
页:
[1]
2