求助：批量插入属性块

jsxygshh

请各位帮忙看一下，如何使用VBA根据坐标批量添加属性块，块的属性即为第三个数字，属性块的名称为“原高程”。先谢谢

you_boss

这是什么类型的对象，打开之后就是这样的，啥也没有

you_boss

能不能转成t3的

chixun99

2. Sub PatchInsertAttBlock()
   
3. '设置给定坐标文件路径
   
4. Dim fileName
   
5.     fileName = ThisDrawing.Path & "\坐标表.txt"
   
6. '使用顺序方式打开文本文件
   
7. Dim fNo
   
8.     fNo = FreeFile
   
9.     Open fileName For Input As #fNo
   
10. '顺序的根据每行坐标插入块并赋值块属性
    
11. Dim vID, BlName, ValueStr
    
12. Dim i As Long, j As Long, k As Long
    
13. Dim vAtt, attTag, attText
    
14. Dim AttBlR As AcadBlockReference
    
15. Dim Ip(2) As Double
    
16.     Ip(2) = 0
    
17.     Do
    
18.         Line Input #fNo, BlName
    
19.         If k > 0 Then   '坐标文件第一行标题调过
    
20.             vID = Split(BlName, ",")
    
21.             ValueStr = vID(2)
    
22.             BlName = "原高程"
    
23.             '转换坐标为double类型并插入块参照
    
24.             Ip(0) = Val(vID(0)): Ip(1) = Val(vID(1))
    
25.             Set AttBlR = ThisDrawing.ModelSpace.InsertBlock(Ip, BlName, 1, 1, 1, 0)
    
26.             '读取块参照属性值，并设置新值
    
27.             vAtt = AttBlR.GetAttributes
    
28.             If IsArray(vAtt) Then
    
29.                 For i = 0 To UBound(vAtt)
    
30.                     If vAtt(i).TagString = BlName Then vAtt(i).TextString = ValueStr
    
31.                 Next
    
32.             End If
    
33.         End If
    
34.         k = k + 1
    
35.     Loop Until EOF(fNo)
    
36.     Close #fNo
    
37.     ThisDrawing.Utility.Prompt "共插入块个数：" & k - 1
    
38. End Sub

Sub PatchInsertAttBlock()<br /> '设置给定坐标文件路径<br /> Dim fileName<br />     fileName = ThisDrawing.Path & "\坐标表.txt"<br /> '使用顺序方式打开文本文件<br /> Dim fNo<br />     fNo = FreeFile<br />     Open fileName For Input As #fNo<br /> '顺序的根据每行坐标插入块并赋值块属性<br /> Dim vID, BlName, ValueStr<br /> Dim i As Long, j As Long, k As Long<br /> Dim vAtt, attTag, attText<br /> Dim AttBlR As AcadBlockReference<br /> Dim Ip(2) As Double<br />     Ip(2) = 0<br />     Do<br />         Line Input #fNo, BlName<br />         If k > 0 Then   '坐标文件第一行标题调过<br />             vID = Split(BlName, ",")<br />             ValueStr = vID(2)<br />             BlName = "原高程"<br />             '转换坐标为double类型并插入块参照<br />             Ip(0) = Val(vID(0)): Ip(1) = Val(vID(1))<br />             Set AttBlR = ThisDrawing.ModelSpace.InsertBlock(Ip, BlName, 1, 1, 1, 0)<br />             '读取块参照属性值，并设置新值<br />             vAtt = AttBlR.GetAttributes<br />             If IsArray(vAtt) Then<br />                 For i = 0 To UBound(vAtt)<br />                     If vAtt(i).TagString = BlName Then vAtt(i).TextString = ValueStr<br />                 Next<br />             End If<br />         End If<br />         k = k + 1<br />     Loop Until EOF(fNo)<br />     Close #fNo<br />     ThisDrawing.Utility.Prompt "共插入块个数：" & k - 1<br /> End Sub

jsxygshh

谢谢，万分感谢，我现在是用EXCEL表格数据进行批量插入的

chixun99

jsxygshh 发表于 2022-12-19 09:05
谢谢，万分感谢，我现在是用EXCEL表格数据进行批量插入的

上边的代码改改就可以了，文本文件改为excel数据表读取就行了。

weimeng555

好东西，之前也打算用Excel坐标表批量插入指定块，先收藏一波，等后面有时间了在研究一下CAD的VBA怎么使用，现在还在用的Excel VBA处理数据