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

ljb600078

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

crossrainbows

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

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

qwh923820

谢谢老师分享！！！

Real_King

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

zzyong00

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

mikewolf2k

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

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

ljb600078

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

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

ljb600078

zzyong00 发表于 2015-12-20 20:34
这是作业题，还是实际项目需要？

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

mikewolf2k

以下是我的一段文字替代的程序，供参考。找到关键字后搜索。
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

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

mikewolf2k

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

ljb600078

谢谢老师指导