求助:批量插入属性块
请各位帮忙看一下,如何使用VBA根据坐标批量添加属性块,块的属性即为第三个数字,属性块的名称为“原高程”。先谢谢这是什么类型的对象,打开之后就是这样的,啥也没有 能不能转成t3的 Sub PatchInsertAttBlock()
'设置给定坐标文件路径
Dim fileName
fileName = ThisDrawing.Path & "\坐标表.txt"
'使用顺序方式打开文本文件
Dim fNo
fNo = FreeFile
Open fileName For Input As #fNo
'顺序的根据每行坐标插入块并赋值块属性
Dim vID, BlName, ValueStr
Dim i As Long, j As Long, k As Long
Dim vAtt, attTag, attText
Dim AttBlR As AcadBlockReference
Dim Ip(2) As Double
Ip(2) = 0
Do
Line Input #fNo, BlName
If k > 0 Then '坐标文件第一行标题调过
vID = Split(BlName, ",")
ValueStr = vID(2)
BlName = "原高程"
'转换坐标为double类型并插入块参照
Ip(0) = Val(vID(0)): Ip(1) = Val(vID(1))
Set AttBlR = ThisDrawing.ModelSpace.InsertBlock(Ip, BlName, 1, 1, 1, 0)
'读取块参照属性值,并设置新值
vAtt = AttBlR.GetAttributes
If IsArray(vAtt) Then
For i = 0 To UBound(vAtt)
If vAtt(i).TagString = BlName Then vAtt(i).TextString = ValueStr
Next
End If
End If
k = k + 1
Loop Until EOF(fNo)
Close #fNo
ThisDrawing.Utility.Prompt "共插入块个数:" & k - 1
End Sub 谢谢,万分感谢,我现在是用EXCEL表格数据进行批量插入的
jsxygshh 发表于 2022-12-19 09:05
谢谢,万分感谢,我现在是用EXCEL表格数据进行批量插入的
上边的代码改改就可以了,文本文件改为excel数据表读取就行了。 好东西,之前也打算用Excel坐标表批量插入指定块,先收藏一波,等后面有时间了在研究一下CAD的VBA怎么使用,现在还在用的Excel VBA处理数据
页:
[1]