[编程申请]：怎样用VB实现…………

tukuitk

怎样用VB实现…………
怎样用VB把一张图中含文字“ABC”的单行文字、多行文字、属性参照的值、属性标签都替换成文字“XYZ”？？？

麻烦各位大虾帮忙解决一下！谢谢！！！
*-*6

efan2000

使用选择集。第一步，选择单行文字、多行文字和属性定义，替换其中的文字。第二步，选择块（注：属性引用只在块引用中出现），枚举所有的属性引用，替换其中的文字。

2. 
   
3.   [FONT=courier new]
   
4. Public Sub TextReplace()
   
5. 
   
6.     '创建选择集，名称为TextReplace
   
7.    
   
8.     Dim SSetObj As AcadSelectionSet
   
9.     On Error Resume Next
   
10.     Set SSetObj = ThisDrawing.SelectionSets("TextReplace")
    
11.     If Err Then
    
12.         Err.Clear
    
13.         Set SSetObj = ThisDrawing.SelectionSets.Add("TextReplace")
    
14.     End If
    
15.     SSetObj.Clear
    
16.     On Error GoTo 0
    
17.    
    
18.     '创建过滤器，仅选择Text（单行文本）、Mtext（多行文本）、AttDef（属性定义）
    
19.    
    
20.     '关于过滤器的详细使用资料，请参考有关书籍
    
21.    
    
22.     Dim fType(0 To 0) As Integer
    
23.     Dim fData(0 To 0) As Variant
    
24.     fType(0) = 0
    
25.     fData(0) = "Text,Mtext,AttDef"
    
26.    
    
27.     '选择全部的Text、Mtext、AttDef
    
28.    
    
29.     SSetObj.Select acSelectionSetAll, , , fType, fData
    
30.    
    
31.     Dim i As Integer
    
32.     If SSetObj.Count <> 0 Then
    
33.         For i = 0 To SSetObj.Count - 1
    
34.             '在Text和Mtext中显示的是TextString，在AttDef中显示的是TagString
    
35.             If TypeOf SSetObj(i) Is AcadAttribute Then
    
36.                 If SSetObj(i).TagString = "ABC" Then SSetObj(i).TagString = "XYZ"
    
37.             Else
    
38.                 If SSetObj(i).TextString = "ABC" Then SSetObj(i).TextString = "XYZ"
    
39.             End If
    
40.         Next
    
41.     End If
    
42.    
    
43.     '清空选择集中的数据，准备下一次操作
    
44.    
    
45.     SSetObj.Clear
    
46.    
    
47.     '创建过滤器，仅选择BlockRef（块引用）
    
48.    
    
49.     fType(0) = 0
    
50.     fData(0) = "Insert"
    
51.    
    
52.     '选择全部的BlockRef
    
53.    
    
54.     SSetObj.Select acSelectionSetAll, , , fType, fData
    
55.    
    
56.     Dim v As Variant
    
57.     Dim j As Integer
    
58.     If SSetObj.Count <> 0 Then
    
59.         For i = 0 To SSetObj.Count - 1
    
60.             If SSetObj(i).HasAttributes Then
    
61.                 v = SSetObj(i).GetAttributes
    
62.                 For j = 0 To UBound(v)
    
63.                     '在BlockRef中的AttRef中显示的是TextString
    
64.                     If v(j).TextString = "ABC" Then v(j).TextString = "XYZ"
    
65.                 Next
    
66.             End If
    
67.         Next
    
68.     End If
    
69.    
    
70.     SSetObj.Clear
    
71.    
    
72.     SSetObj.Delete
    
73.    
    
74.     Set SSetObj = Nothing
    
75. End Sub
    
76.   [/FONT]
    

<br />   [FONT=courier new]<br /> Public Sub TextReplace()<br /> <br />     '创建选择集，名称为TextReplace<br />     <br />     Dim SSetObj As AcadSelectionSet<br />     On Error Resume Next<br />     Set SSetObj = ThisDrawing.SelectionSets("TextReplace")<br />     If Err Then<br />         Err.Clear<br />         Set SSetObj = ThisDrawing.SelectionSets.Add("TextReplace")<br />     End If<br />     SSetObj.Clear<br />     On Error GoTo 0<br />     <br />     '创建过滤器，仅选择Text（单行文本）、Mtext（多行文本）、AttDef（属性定义）<br />     <br />     '关于过滤器的详细使用资料，请参考有关书籍<br />     <br />     Dim fType(0 To 0) As Integer<br />     Dim fData(0 To 0) As Variant<br />     fType(0) = 0<br />     fData(0) = "Text,Mtext,AttDef"<br />     <br />     '选择全部的Text、Mtext、AttDef<br />     <br />     SSetObj.Select acSelectionSetAll, , , fType, fData<br />     <br />     Dim i As Integer<br />     If SSetObj.Count <> 0 Then<br />         For i = 0 To SSetObj.Count - 1<br />             '在Text和Mtext中显示的是TextString，在AttDef中显示的是TagString<br />             If TypeOf SSetObj(i) Is AcadAttribute Then<br />                 If SSetObj(i).TagString = "ABC" Then SSetObj(i).TagString = "XYZ"<br />             Else<br />                 If SSetObj(i).TextString = "ABC" Then SSetObj(i).TextString = "XYZ"<br />             End If<br />         Next<br />     End If<br />     <br />     '清空选择集中的数据，准备下一次操作<br />     <br />     SSetObj.Clear<br />     <br />     '创建过滤器，仅选择BlockRef（块引用）<br />     <br />     fType(0) = 0<br />     fData(0) = "Insert"<br />     <br />     '选择全部的BlockRef<br />     <br />     SSetObj.Select acSelectionSetAll, , , fType, fData<br />     <br />     Dim v As Variant<br />     Dim j As Integer<br />     If SSetObj.Count <> 0 Then<br />         For i = 0 To SSetObj.Count - 1<br />             If SSetObj(i).HasAttributes Then<br />                 v = SSetObj(i).GetAttributes<br />                 For j = 0 To UBound(v)<br />                     '在BlockRef中的AttRef中显示的是TextString<br />                     If v(j).TextString = "ABC" Then v(j).TextString = "XYZ"<br />                 Next<br />             End If<br />         Next<br />     End If<br />     <br />     SSetObj.Clear<br />     <br />     SSetObj.Delete<br />     <br />     Set SSetObj = Nothing<br /> End Sub<br />   [/FONT]<br />

tukuitk

efan2000兄，我在明经中也见你的这个程序了，我想知道在VB中怎样实现？
批量替换一个文件夹中的所有图形呢？
谢谢你！！！

irol

*-*c *-*9 *-*a *-*2 *-*8

efan2000

批量的话就要一张张打开，然后执行替换，再关闭，用DBX就行，不过不能脱离ACAD的环境。
好象网上有一个控件可以读取DWG格式的图纸，可以去找找试一下。

tukuitk

efan2000兄，明经里有个减肥工具，用VB写的，你能根据它写出来吗？

efan2000

你是想在VBA中实现？它的原理是清除图纸中没有使用的块、线型、文字样式等，然后再另外一个新的文件，缩小文件的尺寸，达到减肥的效果。

randyhuang

我也遇到同样的问题。
请问5楼，能找到这个控件吗？r14能用DXB吗

自由的鱼

R14中不可以用DBX