求助VBA操作CAD中的块

我是小黑屋

如上CAD图中这个名称为“测试模块”的块，想通过excel中使用VBA读取指定的单元格上的数值更改到cad这个块中去，然后保存。

我使用gpt问出了获取到打开图纸中的指定块。但是添加获取它这个块的属性的时候，代码报错，运行不了。求助下有这方面的大佬帮忙看看如何实现这个修改块属性值。 Desktop.zip (265.46 KB, 下载次数: 17)

2023-9-9 15:02 上传

点击文件名下载附件

我是小黑屋

有大神会吗

我是小黑屋

人工置顶下

沈默00

厉害了，VBA还能操作CAD?
不知道能不能操作UG，有大神了解的一起解惑一下

caiyu93

严格来说这个就不属于vba的事了,应该是vb6的事,vba来做没vb6舒服

wxhnr

我这边运行没报错。

我是小黑屋

wxhnr 发表于 2023-9-12 13:27
我这边运行没报错。

1. Sub SetAttributeValue()
   
2.     Dim objAcadApp As Object
   
3.     Dim objAcadDoc As Object
   
4.     Dim objBlockRef As Object
   
5.     Dim objBlockRefs As Object
   
6.     Dim strBlockName As String
   
7.     Dim strAttributeName As String
   
8.     Dim strAttributeValue As String
   
9.     Dim blnBlockRefFound As Boolean
   
10. 
    
11.     '连接到AutoCAD应用程序
    
12.     On Error Resume Next
    
13.     Set objAcadApp = GetObject(, "AutoCAD.Application")
    
14.     If objAcadApp Is Nothing Then
    
15.         Set objAcadApp = CreateObject("AutoCAD.Application")
    
16.     End If
    
17.     On Error GoTo 0
    
18. 
    
19.     '检查是否连接到AutoCAD
    
20.     If objAcadApp Is Nothing Then
    
21.         MsgBox "无法连接到AutoCAD"
    
22.         Exit Sub
    
23.     End If
    
24. 
    
25.     '获取当前打开的图档
    
26.     Set objAcadDoc = objAcadApp.ActiveDocument
    
27. 
    
28.     '检查是否打开了图档
    
29.     If objAcadDoc Is Nothing Then
    
30.         MsgBox "未打开图档"
    
31.         Exit Sub
    
32.     End If
    
33. 
    
34.     '获取指定块参照对象的块名称、属性名称和属性值
    
35.     strBlockName = "测试模块"
    
36.     strAttributeName = "宽度"
    
37.     strAttributeValue = "1400"
    
38. 
    
39. 
    
40.     '遍历所有块参照对象并查找指定块参照对象
    
41.     For Each objBlockRef In objBlockRefs
    
42.         If objBlockRef.Name = strBlockName Then
    
43.             blnBlockRefFound = True
    
44.             '获取块参照对象的所有属性
    
45.             Dim vAtt As Variant
    
46.             vAtt = objBlockRef.GetAttributes
    
47.             If IsArray(vAtt) Then
    
48.                 '遍历属性集合并查找标签(TagString)等于指定块名称(BlName)的属性
    
49.                 Dim i As Integer
    
50.                 For i = LBound(vAtt) To UBound(vAtt)
    
51.                     If vAtt(i).TagString = strAttributeName Then
    
52.                         '设置属性值(TextString)为指定的值(ValueStr)
    
53.                         vAtt(i).TextString = strAttributeValue
    
54.                         Exit For
    
55.                     End If
    
56.                 Next i
    
57.             End If
    
58.             Exit For
    
59.         End If
    
60.     Next objBlockRef
    
61. 
    
62.     '提示块参照对象是否存在
    
63.     If blnBlockRefFound Then
    
64.         MsgBox "块参照对象存在"
    
65.     Else
    
66.         MsgBox "块参照对象不存在"
    
67.     End If
    
68. End Sub
    

复制代码

你地铁图

沈默00 发表于 2023-9-12 10:19
厉害了，VBA还能操作CAD?
不知道能不能操作UG，有大神了解的一起解惑一下

都是vba......

我是小黑屋

已完美解决

titan0630

我用的是CAD2010，报错