从excel向图形中添加文本
嗨，朋友们，我需要添加文本从excel文件到cad绘图lisp例行程序。阅读图纸文本和excel文件文本，如果匹配，请将相关内容从excel粘贴到cad。
例如：我的绘图文本包含“B2”，我的excel文件在“D”列包含“B2”文本，然后将excel文件的“E”列中的值粘贴到B2文本旁边的Cad绘图中。
请查找Cad和Excel文件的示例文件。
谢谢
样品图纸。dxf
首先，将excel文件保存为csv，然后尝试以下操作：
(defun c:csv2txt (/ file data ss in enx txt addtxt)
(if
(and
(setq file (getfiled "Select CSV File" "" "csv" 16))
(setq data (LM:readcsv file))
(setq ss (ssget '((0 . "TEXT"))))
)
(repeat (setq in (sslength ss))
(setq enx (entget (ssname ss (setq in (1- in)))))
(setq txt (cdr (assoc 1 enx)))
(foreach _X data
(if (setq addtxt (cadr(member txt _X)))
(progn
(setq enx (subst (cons 1 (strcat txt addtxt)) (assoc 1 enx) enx ))
(entmod enx)
(entupd (ssname ss in))
)
)
)
)
)
(princ)
)
当然你必须加载这个
http://www.lee-mac.com/readcsv.html 嗨，朋友，
谢谢分享。使用代码后，在命令行上将错误显示为“CSV2Text；错误：无函数定义：LM:READCSV”。文本未开发。请看一看。
样品图纸。dxf
测试文件。csv 这是你必须从这里下载的东西：http://www.lee-mac.com/readcsv.html
亲爱的朋友，我不知道编程技巧。请提供lisp例程。
非常感谢。
我给了你们网站的链接，在那个里你们可以找到缺失的功能。
再一次，但直接链接到文件，您必须加载该文件才能运行我的例程。
http://www.lee-mac.com/lisp/ReadCSV-V1-3.lsp 考虑这一点（需要一些特定的文本重新格式化）：
(defun C:test ( / acDoc SSX f opn row LstRows i TxtLst a b)
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-map-collection (vla-get-Layers acDoc) (function (lambda (o) (vla-put-Lock o :vlax-false))))
(if
(and
(setq SSX (ssget "_X" (list (cons 0 "TEXT") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
(setq f (getfiled "Select CSV File" "" "csv" 0))
)
(progn
(vla-EndUndoMark acDoc)(vla-StartUndoMark acDoc)
(setq opn (open f "r"))
(while (setq row (read-line opn)) (setq LstRows (cons row LstRows)))
(close opn)
(repeat (setq i (sslength SSX)) (setq TxtLst (cons (entget (ssname SSX (setq i (1- i))))TxtLst)) )
(if (and LstRows TxtLst)
(foreach a LstRows
(foreach b TxtLst
(and ; sloppy string reformatting below
(wcmatch a (strcat "*" (cdr (assoc 1 b)) "*"))
(setq a (vl-string-subst "(" "Reg" a))
(setq a (vl-remove "\"" (vl-remove "," (mapcar 'chr (vl-string->list a)))))
(if (/= (last a) ")") (setq a (strcat (apply 'strcat a) ")")) (setq a (apply 'strcat a)))
(setq a (vl-string-subst "\")" ")" (vl-string-subst "\"x" "x" a)))
(entmod (setq b (subst (cons 1 a) (assoc 1 b) b)))
(entupd (cdr (assoc -1 b)))
)
)
)
)
(vla-EndUndoMark acDoc)
)
)
(princ)
);| defun |; (vl-load-com) (princ)
亲爱的朋友，
我遵循了你的规则，但开发了“reg”而不是像9“x18”这样的尺寸。文本后缺少括号。示例：B1（9“x4½”）格式。
非常感谢。
嗨，朋友，你的代码运行良好。但excel中的一列文本不一定是开发出来的。这是excel文件中的“A”列文本。文本应从excel的“B”列而不是“A”列中提取。文本开发为G1B1（9“x4½”）。此处不需要G1。所需格式为B1（9“x4½”）。
请修改以进行小修改。
感谢您的贡献。
快速纠正（未经测试）：
(defun C:test ( / acDoc SSX f opn row LstRows i TxtLst a b)
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-map-collection (vla-get-Layers acDoc) (function (lambda (o) (vla-put-Lock o :vlax-false))))
(if
(and
(setq SSX (ssget "_X" (list (cons 0 "TEXT") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
(setq f (getfiled "Select CSV File" "" "csv" 0))
)
(progn
(vla-EndUndoMark acDoc)(vla-StartUndoMark acDoc)
(setq LstRows (mapcar 'cadr (LM:readcsv f)))
; (setq opn (open f "r"))
; (while (setq row (read-line opn)) (setq LstRows (cons row LstRows)))
; (close opn)
(repeat (setq i (sslength SSX)) (setq TxtLst (cons (entget (ssname SSX (setq i (1- i))))TxtLst)) )
(if (and LstRows TxtLst)
(foreach a LstRows
(foreach b TxtLst
(and ; sloppy string reformatting below
(wcmatch a (strcat "*" (cdr (assoc 1 b)) "*"))
(setq a (vl-string-subst "(" "Reg" a))
(setq a (member "B" (vl-remove "\"" (vl-remove "," (mapcar 'chr (vl-string->list a))))))
(if (/= (last a) ")") (setq a (strcat (apply 'strcat a) ")")) (setq a (apply 'strcat a)))
(setq a (vl-string-subst "\")" ")" (vl-string-subst "\"x" "x" a)))
(entmod (setq b (subst (cons 1 a) (assoc 1 b) b)))
(entupd (cdr (assoc -1 b)))
)
)
)
)
(vla-EndUndoMark acDoc)
)
)
(princ)
);| defun |; (vl-load-com) (princ)
;; Read CSV-Lee Mac
;; Parses a CSV file into a matrix list of cell values.
;; csv - filename of CSV file to read
(defun LM:readcsv ( csv / des lst sep str )
(if (setq des (open csv "r"))
(progn
(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
(while (setq str (read-line des))
(setq lst (cons (LM:csv->lst str sep 0) lst))
)
(close des)
)
)
(reverse lst)
)
;; CSV -> List-Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - string read from CSV file
;; sep - CSV separator token
;; pos - initial position index (always zero)
(defun LM:csv->lst ( str sep pos / s )
(cond
( (not (setq pos (vl-string-search sep str pos)))
(if (wcmatch str "\"*\"")
(list (LM:csv-replacequotes (substr str 2 (- (strlen str) 2))))
(list str)
)
)
( (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]")
(and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos)))
)
(LM:csv->lst str sep (+ pos 2))
)
( (wcmatch s "\"*\"")
(cons
(LM:csv-replacequotes (substr str 2 (- pos 2)))
(LM:csv->lst (substr str (+ pos 2)) sep 0)
)
)
( (cons s (LM:csv->lst (substr str (+ pos 2)) sep 0)))
)
)
(defun LM:csv-replacequotes ( str / pos )
(setq pos 0)
(while (setq pos (vl-string-search"\"\"" str pos))
(setq str (vl-string-subst "\"" "\"\"" str pos)
pos (1+ pos)
)
)
str
)
全部归功于李·麦克。
页:
[1]
2