乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
查看： 38|回复： 19

[编程交流] 从excel向图形中添加文本

[复制链接]
structo

14

主题

75

帖子

65

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
75
发表于 2022-7-5 16:56:34 | 显示全部楼层 |阅读模式
嗨，朋友们，
 
我需要添加文本从excel文件到cad绘图lisp例行程序。阅读图纸文本和excel文件文本，如果匹配，请将相关内容从excel粘贴到cad。
例如：我的绘图文本包含“B2”，我的excel文件在“D”列包含“B2”文本，然后将excel文件的“E”列中的值粘贴到B2文本旁边的Cad绘图中。
 
请查找Cad和Excel文件的示例文件。
 
谢谢
样品图纸。dxf
175634n22y7x93ye6ian79.jpg
回复

使用道具 举报

ziele_o2k

46

主题

161

帖子

104

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
242
发表于 2022-7-5 17:02:28 | 显示全部楼层
首先，将excel文件保存为csv，然后尝试以下操作：
  2. [color=RED]([/color][color=BLUE]defun[/color] c:csv2txt [color=RED]([/color][color=BLUE]/[/color] file data ss in enx txt addtxt[color=RED])[/color]
  3.  [color=RED]([/color][color=BLUE]if[/color]
  4.    [color=RED]([/color][color=BLUE]and[/color]
  5.      [color=RED]([/color][color=BLUE]setq[/color] file [color=RED]([/color][color=BLUE]getfiled[/color] [color=#a52a2a]"Select CSV File"[/color] [color=#a52a2a]""[/color] [color=#a52a2a]"csv"[/color] [color=#009900]16[/color][color=RED]))[/color]
  6.      [color=RED]([/color][color=BLUE]setq[/color] data [color=RED]([/color][color=BLUE]LM:readcsv[/color] file[color=RED]))[/color]
  7.      [color=RED]([/color][color=BLUE]setq[/color] ss [color=RED]([/color][color=BLUE]ssget[/color] [color=DARKRED]'[/color][color=RED](([/color][color=#009900]0[/color] [color=DARKRED].[/color] [color=#a52a2a]"TEXT"[/color][color=RED]))))[/color]
  8.    [color=RED])[/color]
  9.    [color=RED]([/color][color=BLUE]repeat[/color] [color=RED]([/color][color=BLUE]setq[/color] in [color=RED]([/color][color=BLUE]sslength[/color] ss[color=RED]))[/color]
  10.      [color=RED]([/color][color=BLUE]setq[/color] enx [color=RED]([/color][color=BLUE]entget[/color] [color=RED]([/color][color=BLUE]ssname[/color] ss [color=RED]([/color][color=BLUE]setq[/color] in [color=RED]([/color][color=BLUE]1-[/color] in[color=RED])))))[/color]
  11.      [color=RED]([/color][color=BLUE]setq[/color] txt [color=RED]([/color][color=BLUE]cdr[/color] [color=RED]([/color][color=BLUE]assoc[/color] [color=#009900]1[/color] enx[color=RED])))[/color]
  12.      [color=RED]([/color][color=BLUE]foreach[/color] _X data
  13.        [color=RED]([/color][color=BLUE]if[/color] [color=RED]([/color][color=BLUE]setq[/color] addtxt [color=RED]([/color][color=BLUE]cadr[/color][color=RED]([/color][color=BLUE]member[/color] txt _X[color=RED])))[/color]
  14.          [color=RED]([/color][color=BLUE]progn[/color]
  15.            [color=RED]([/color][color=BLUE]setq[/color] enx [color=RED]([/color][color=BLUE]subst[/color] [color=RED]([/color][color=BLUE]cons[/color] [color=#009900]1[/color] [color=RED]([/color][color=BLUE]strcat[/color] txt addtxt[color=RED]))[/color] [color=RED]([/color][color=BLUE]assoc[/color] [color=#009900]1[/color] enx[color=RED])[/color] enx [color=RED]))[/color]
  16.            [color=RED]([/color][color=BLUE]entmod[/color] enx[color=RED])[/color]
  17.            [color=RED]([/color][color=BLUE]entupd[/color] [color=RED]([/color][color=BLUE]ssname[/color] ss in[color=RED]))[/color]
  18.          [color=RED])[/color]
  19.        [color=RED])[/color]
  20.      [color=RED])[/color]
  21.    [color=RED])[/color]
  22.  [color=RED])[/color]
  23.  [color=RED]([/color][color=BLUE]princ[/color][color=RED])[/color]
  24. [color=RED])[/color]

当然你必须加载这个
http://www.lee-mac.com/readcsv.html
回复

使用道具 举报

structo

14

主题

75

帖子

65

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
75
发表于 2022-7-5 17:05:09 | 显示全部楼层
嗨，朋友，
谢谢分享。使用代码后，在命令行上将错误显示为“CSV2Text；错误：无函数定义：LM:READCSV”。文本未开发。请看一看。
样品图纸。dxf
测试文件。csv
回复

使用道具 举报

guran

2

主题

84

帖子

83

银币

初来乍到

Rank: 1

铜币
9
发表于 2022-7-5 17:08:34 | 显示全部楼层
这是你必须从这里下载的东西：http://www.lee-mac.com/readcsv.html
回复

使用道具 举报

structo

14

主题

75

帖子

65

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
75
发表于 2022-7-5 17:12:02 | 显示全部楼层
 
亲爱的朋友，我不知道编程技巧。请提供lisp例程。
 
非常感谢。
回复

使用道具 举报

ziele_o2k

46

主题

161

帖子

104

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
242
发表于 2022-7-5 17:15:06 | 显示全部楼层
 
我给了你们网站的链接，在那个里你们可以找到缺失的功能。
再一次，但直接链接到文件，您必须加载该文件才能运行我的例程。
http://www.lee-mac.com/lisp/ReadCSV-V1-3.lsp
回复

使用道具 举报

Grrr

66

主题

1552

帖子

1514

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
325
发表于 2022-7-5 17:16:13 | 显示全部楼层
考虑这一点（需要一些特定的文本重新格式化）：
 
  2. (defun C:test ( / acDoc SSX f opn row LstRows i TxtLst a b)
  4. (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  5. (vlax-map-collection (vla-get-Layers acDoc) (function (lambda (o) (vla-put-Lock o :vlax-false))))
  6. (if 
  7.         (and
  8.                 (setq SSX (ssget "_X" (list (cons 0 "TEXT") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
  9.                 (setq f (getfiled "Select CSV File" "" "csv" 0))
  10.         )
  11.         (progn
  12.                 (vla-EndUndoMark acDoc)(vla-StartUndoMark acDoc)
  13.                 (setq opn (open f "r"))
  14.                 (while (setq row (read-line opn)) (setq LstRows (cons row LstRows)))
  15.                 (close opn)
  16.                 (repeat (setq i (sslength SSX)) (setq TxtLst (cons (entget (ssname SSX (setq i (1- i))))  TxtLst)) )
  17.                 (if (and LstRows TxtLst)
  18.                         (foreach a LstRows
  19.                                 (foreach b TxtLst
  20.                                         (and ; sloppy string reformatting below
  21.                                                 (wcmatch a (strcat "*" (cdr (assoc 1 b)) "*"))
  22.                                                 (setq a (vl-string-subst "(" "Reg" a))
  23.                                                 (setq a (vl-remove """ (vl-remove "," (mapcar 'chr (vl-string->list a)))))
  24.                                                 (if (/= (last a) ")") (setq a (strcat (apply 'strcat a) ")")) (setq a (apply 'strcat a)))
  25.                                                 (setq a (vl-string-subst "")" ")" (vl-string-subst ""x" "x" a)))
  26.                                                 (entmod (setq b (subst (cons 1 a) (assoc 1 b) b)))
  27.                                                 (entupd (cdr (assoc -1 b)))
  28.                                         )
  29.                                 )
  30.                         )
  31.                 )
  32.                 (vla-EndUndoMark acDoc)
  33.         )
  34. )
  35. (princ)
  36. );| defun |; (vl-load-com) (princ)
回复

使用道具 举报

structo

14

主题

75

帖子

65

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
75
发表于 2022-7-5 17:21:30 | 显示全部楼层
亲爱的朋友，
 
我遵循了你的规则，但开发了“reg”而不是像9“x18”这样的尺寸。文本后缺少括号。示例：B1（9“x4½”）格式。
 
非常感谢。
回复

使用道具 举报

structo

14

主题

75

帖子

65

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
75
发表于 2022-7-5 17:25:04 | 显示全部楼层
 
嗨，朋友，你的代码运行良好。但excel中的一列文本不一定是开发出来的。这是excel文件中的“A”列文本。文本应从excel的“B”列而不是“A”列中提取。文本开发为G1B1（9“x4½”）。此处不需要G1。所需格式为B1（9“x4½”）。
 
请修改以进行小修改。
 
感谢您的贡献。
回复

使用道具 举报

Grrr

66

主题

1552

帖子

1514

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
325
发表于 2022-7-5 17:26:36 | 显示全部楼层
 
快速纠正（未经测试）：
 
  2. (defun C:test ( / acDoc SSX f opn row LstRows i TxtLst a b)
  4. (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  5. (vlax-map-collection (vla-get-Layers acDoc) (function (lambda (o) (vla-put-Lock o :vlax-false))))
  6. (if 
  7.         (and
  8.                 (setq SSX (ssget "_X" (list (cons 0 "TEXT") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
  9.                 (setq f (getfiled "Select CSV File" "" "csv" 0))
  10.         )
  11.         (progn
  12.                 (vla-EndUndoMark acDoc)(vla-StartUndoMark acDoc)
  13.                 [color="red"](setq LstRows (mapcar 'cadr (LM:readcsv f)))[/color]
  14.                 [color="darkgreen"]; (setq opn (open f "r"))
  15.                 ; (while (setq row (read-line opn)) (setq LstRows (cons row LstRows)))
  16.                 ; (close opn)[/color]
  17.                 (repeat (setq i (sslength SSX)) (setq TxtLst (cons (entget (ssname SSX (setq i (1- i))))  TxtLst)) )
  18.                 (if (and LstRows TxtLst)
  19.                         (foreach a LstRows
  20.                                 (foreach b TxtLst
  21.                                         (and ; sloppy string reformatting below
  22.                                                 (wcmatch a (strcat "*" (cdr (assoc 1 b)) "*"))
  23.                                                 (setq a (vl-string-subst "(" "Reg" a))
  24.                                                 (setq a [color="red"](member "B"[/color] (vl-remove """ (vl-remove "," (mapcar 'chr (vl-string->list a))))[color="red"])[/color])
  25.                                                 (if (/= (last a) ")") (setq a (strcat (apply 'strcat a) ")")) (setq a (apply 'strcat a)))
  26.                                                 (setq a (vl-string-subst "")" ")" (vl-string-subst ""x" "x" a)))
  27.                                                 (entmod (setq b (subst (cons 1 a) (assoc 1 b) b)))
  28.                                                 (entupd (cdr (assoc -1 b)))
  29.                                         )
  30.                                 )
  31.                         )
  32.                 )
  33.                 (vla-EndUndoMark acDoc)
  34.         )
  35. )
  36. (princ)
  37. );| defun |; (vl-load-com) (princ)
  39. [color="darkgreen"]
  40. ;; Read CSV  -  Lee Mac
  41. ;; Parses a CSV file into a matrix list of cell values.
  42. ;; csv - [str] filename of CSV file to read[/color]
  43. [color="red"]
  44. (defun LM:readcsv ( csv / des lst sep str )
  45. (if (setq des (open csv "r"))
  46.         (progn
  47.                 (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
  48.                 (while (setq str (read-line des))
  49.                         (setq lst (cons (LM:csv->lst str sep 0) lst))
  50.                 )
  51.                 (close des)
  52.         )
  53. )
  54. (reverse lst)
  55. )
  58. ;; CSV -> List  -  Lee Mac
  59. ;; Parses a line from a CSV file into a list of cell values.
  60. ;; str - [str] string read from CSV file
  61. ;; sep - [str] CSV separator token
  62. ;; pos - [int] initial position index (always zero)
  64. (defun LM:csv->lst ( str sep pos / s )
  65. (cond
  66.         (   (not (setq pos (vl-string-search sep str pos)))
  67.                 (if (wcmatch str ""*"")
  68.                         (list (LM:csv-replacequotes (substr str 2 (- (strlen str) 2))))
  69.                         (list str)
  70.                 )
  71.         )
  72.         (   (or (wcmatch (setq s (substr str 1 pos)) ""*[~"]")
  73.                 (and (wcmatch s "~*[~"]*") (= 1 (logand 1 pos)))
  74.         )
  75.         (LM:csv->lst str sep (+ pos 2))
  76.         )
  77.         (   (wcmatch s ""*"")
  78.                 (cons
  79.                         (LM:csv-replacequotes (substr str 2 (- pos 2)))
  80.                         (LM:csv->lst (substr str (+ pos 2)) sep 0)
  81.                 )
  82.         )
  83.         (   (cons s (LM:csv->lst (substr str (+ pos 2)) sep 0)))
  84. )
  85. )
  87. (defun LM:csv-replacequotes ( str / pos )
  88. (setq pos 0)
  89. (while (setq pos (vl-string-search  """" str pos))
  90.         (setq str (vl-string-subst """ """" str pos)
  91.                 pos (1+ pos)
  92.         )
  93. )
  94. str
  95. )                
  96. [/color]

全部归功于李·麦克。
回复

使用道具 举报

12下一页
返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-13 13:16 , Processed in 0.962930 second(s), 75 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表