相信自己666 发表于 2019-9-8 08:44:35

求款可以利用读取EXCEL表格，批量替换CAD图中文字的lisp，请大神赐教，十分感谢！

求款可以利用读取EXCEL表格，批量替换CAD图中文字的lisp，请大神赐教，十分感谢！

pxr201419 发表于 2019-9-8 08:44:36



东拉西扯来的，凑合用吧
(defun c:plth ()
    (vl-load-com)
    (setvar "cmdecho" 0)
    (defun Excel-Get-CellValue (xlapp cell)
        (setq xlsrng (vlax-get-property xlapp "range" cell))
        (setq xlsval (vlax-variant-value (vlax-get-property xlsrng "Value"))))
    (defun th ()
        (setq ss (ssget "X" '((0 . "TEXT"))) i 0)
        (while (< i (sslength ss))
          (setq e    (ssname ss i)
                  st   (entget e)
                  text (cdr (assoc 1 st)))
          (while (setq ks (vl-string-search st1 text))
                (setq len(strlen text)
                      len1 (strlen st1)
                      fro(substr text 1 ks)
                      bak(substr text (+ 1 ks len1)))
                (setq text (strcat fro st2 bak))
                (entmod (subst (cons 1 text) (assoc 1 st) st)))
          (setq i (1+ i))
          ))
    (setq xfile (getfiled "选择包含替换内容的EXCEL文件" "" "xls;xlsx" 8))
    (if        (setq fn (findfile xfile))
        (if (setq xlapp (vlax-get-or-create-object "Excel.Application"))
             (progn
                   (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Open fn)
                   (setq row 2)
                   (while (setq        st1 (Excel-Get-CellValue xlapp (strcat "A" (rtos row))))
                     (setq st2 (Excel-Get-CellValue xlapp (strcat "B" (rtos row))))
                     (th)
                     (setq row (1+ row))
                   )
                   (vlax-invoke-method xlapp 'quit)
                   (vlax-release-object xlapp)
             );progn
        );if
    );if
    (setvar "cmdecho" 1)
    (princ)
)
(prompt "读取EXCEL文件进行文字替换，命令：plth")(princ)

pxr201419 发表于 2019-9-8 12:55:05

命令行输入PLTH，在弹窗选择EXCEL文件并打开

相信自己666 发表于 2019-9-8 13:47:16

pxr201419 发表于 2019-9-8 12:55
命令行输入PLTH，在弹窗选择EXCEL文件并打开

老师lisp源码可以发享下吗？发邮箱也行254762580@qq.com，谢谢老师

相信自己666 发表于 2019-9-8 16:56:03

pxr201419 发表于 2019-9-8 13:58
东拉西扯来的，凑合用吧
(defun c:plth ()
    (vl-load-com)


亲试好用的，十分感谢分享

longer88 发表于 2019-9-9 00:43:50

感谢分享。。。。。。。

嘎小闹 发表于 2019-9-9 11:04:48

请问excel怎么编辑呢？有没有什么固定的格式啊

pxr201419 发表于 2019-9-9 11:36:32

嘎小闹 发表于 2019-9-9 11:04
请问excel怎么编辑呢？有没有什么固定的格式啊

A列放原来的文字，B列放替换后的文字，所有要替换的内容不要隔行就行了

longer88 发表于 2019-9-10 08:29:58

十分感谢分享

嘎小闹 发表于 2019-9-10 10:42:25

pxr201419 发表于 2019-9-9 11:36
A列放原来的文字，B列放替换后的文字，所有要替换的内容不要隔行就行了

下载您的样例就可以改 自己随便编辑一下 然后按照您的样例就改不了 不知道问题出在哪了啊

pxr201419 发表于 2019-9-10 11:07:19

嘎小闹 发表于 2019-9-10 10:42
下载您的样例就可以改 自己随便编辑一下 然后按照您的样例就改不了 不知道问题出在哪了啊

上传你的EXCEL文件和dwg文件

嘎小闹 发表于 2019-9-10 20:44:15

pxr201419 发表于 2019-9-10 11:07
上传你的EXCEL文件和dwg文件

我就简单做的样例请大神帮我看看我的问题出在哪为什么不能替换呢？

pxr201419 发表于 2019-9-10 22:38:04

嘎小闹 发表于 2019-9-10 20:44
我就简单做的样例请大神帮我看看我的问题出在哪为什么不能替换呢？

1、前面程序编得粗糙，只适用于单行文字，没有考虑多行文字，你的图中文字为多行文字。将第8行改为
        (setq ss (ssget "X" '((0 . "*TEXT"))) i 0) 就可以了。
2、第28、29行改一下，原来程序的不严谨：
(while (setq        st1 (Excel-Get-CellValue xlapp (strcat "A" (rtos row 2 0))))
                     (setq st2 (Excel-Get-CellValue xlapp (strcat "B" (rtos row 2 0))))
多谢你的测试，有问题再说。

嘎小闹 发表于 2019-9-11 11:39:10

pxr201419 发表于 2019-9-10 22:38
1、前面程序编得粗糙，只适用于单行文字，没有考虑多行文字，你的图中文字为多行文字。将第8行改为
        (se ...

感谢大神指点 好用了刚刚亲测的但是缺点是：单行文字不能修改了只能修改多行文字还想请教一下 大神能不能帮忙做一个可以根据实测点的坐标和高程来生成横断面的插件啊

rxbwyl 发表于 2019-9-13 18:06:53

十分感谢分享
页: [1] 2
查看完整版本: 求款可以利用读取EXCEL表格，批量替换CAD图中文字的lisp，请大神赐教，十分感谢！