ljb600078 发表于 2015-12-19 21:12:20

（求助）各位老师请指教，通过Excel Vba批量替换CAD中指定文本

         通过EXCEL数据data1至data9数据，逐行批量替换CAD图中的文本数值（data1至data9数据），并按K列数值命名CAD文件；请各位老师指教，不胜感激！！

crossrainbows 发表于 2017-7-31 11:40:20

mikewolf2k 发表于 2015-12-21 09:26
想必楼主的实际情况应该是有一个图示的模板，然后根据excel各列，批量生成不同的文件。
1. 打开模板文件
...

你好，请帮忙实现一下。怎么搜索相关帖子。我现在也需用EXCEL里的数据，替换到CAD相应的文字上。

qwh923820 发表于 2017-8-16 14:24:18

谢谢老师分享！！！

Real_King 发表于 2015-12-20 18:40:10

遍历文字判断内容给再对应更改

zzyong00 发表于 2015-12-20 20:34:10

这是作业题，还是实际项目需要？

mikewolf2k 发表于 2015-12-21 09:26:53

想必楼主的实际情况应该是有一个图示的模板，然后根据excel各列，批量生成不同的文件。
1. 打开模板文件
2. 遍历所有文字，寻找data1，找到后替换为相应字符。循环处理data2~data9.
3. 文件另存为K。关闭K。
4. 循环excel，重复1~3步骤。

VBA完成无压力。每步如何完成，可搜索相关帖子。

ljb600078 发表于 2015-12-21 13:46:29

mikewolf2k 发表于 2015-12-21 09:26 static/image/common/back.gif
想必楼主的实际情况应该是有一个图示的模板，然后根据excel各列，批量生成不同的文件。
1. 打开模板文件
...

感谢老师点播，请教下通过EXCEL怎么实现在CAD中查找data1，并替换为相应的字符，新手菜鸟，让老师费心了，谢谢！

ljb600078 发表于 2015-12-21 13:49:08

zzyong00 发表于 2015-12-20 20:34 static/image/common/back.gif
这是作业题，还是实际项目需要？

通信设计图签名使用，想着简化一下，偷个懒，标准图的话，改个名字和项目名称就可以套图了

mikewolf2k 发表于 2015-12-21 15:43:37

以下是我的一段文字替代的程序，供参考。找到关键字后搜索。
Sub replacetext2()
    Dim Excelapp As Application
    Dim currentrow As Integer
    Call LinkExcel(Excelapp)'连接excel
    Dim I As Integer, J As Integer
    Dim Oldtext As String, Newtext As String, replaced As Boolean
    replaced = False
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = CreateSelectionSet("textobj")
    currentrow = Excelapp.ActiveCell.Row
       Dim FType, FData
       BuildFilter FType, FData, -4, "<or", 0, "text", 0, "mtext", -4, "or>"
       ssetObj.SelectOnScreen FType, FData
       For J = Excelapp.Selection.Row To Excelapp.Selection.Row + UBound(Excelapp.Selection.Formula) - 1
         replaced = False
         For I = 0 To ssetObj.Count - 1
               If ssetObj.Item(I).textString = Excelapp.Cells(J, 1).Value Then
                  ssetObj.Item(I).textString = Excelapp.Cells(J, 20).Value
                  ssetObj.Item(I).Update
                  ssetObj.Item(I).Color = acBlue
                  replaced = True
               End If
         Next I
         If replaced = False Then
            ActiveDocument.Utility.Prompt vbLf & Excelapp.Cells(J, 1).Value & "未替换，请检查！" & vbCr
            Else
            Excelapp.Cells(J, 1).Value = Excelapp.Cells(J, 20).Value
         End If
       Next J
    ssetObj.Clear
    MsgBox "管道编号替换完毕！"
    'excelapp.Visible = True
End Sub

mikewolf2k 发表于 2015-12-21 16:52:48

这个也可以参考下：
http://bbs.mjtd.com/thread-112813-1-1.html

mikewolf2k 发表于 2015-12-25 12:21:30

根据楼主需求，改进了以前的批量替代程序。楼主只需要先把模板文件拷好即可。
http://bbs.mjtd.com/thread-32200-4-1.html

ljb600078 发表于 2016-1-17 22:29:44

谢谢老师指导
页: [1] 2
查看完整版本: （求助）各位老师请指教，通过Excel Vba批量替换CAD中指定文本