已解决，在excel中通过VBA修改CAD中的动态块的自定义属性值
本帖最后由 willj 于 2023-9-13 12:45 编辑如图想在excel中使用VBA修改红色箭头的值，更新保存到CAD中去。
本帖最后由 willj 于 2023-9-13 15:38 编辑
chixun99 发表于 2023-9-13 09:47
Set MyObj = acadModelSpace.Item(7)这个是整个模型空间（modelspace）中序号7的图元，刚好能蒙到也行吧。 ...完美解决了，多谢指点
'循环遍历所有块参照对象
For Each MyObj In acadModelSpace
'判断是否是块参照对象
If MyObj.EntityName = "AcDbBlockReference" Then
'获取块的名称
blkName = MyObj.EffectiveName
'判断是否是要获取动态块属性的块参照对象
If blkName = "测试模块" Then
'获取动态块属性
Dim props As Variant
props = MyObj.GetDynamicBlockProperties
val = Range("B1") '宽度
val2 = Range("B2")'深度
val3 = Range("B3")'平板灯
'循环遍历动态块属性
Dim prop As Variant
For Each prop In props
'获取属性名称和值
On Error Resume Next
Select Case prop.PropertyName
Case "宽度"
prop.value = val
Case "深度"
prop.value = val2
Case "顶开孔"
prop.value = val3
End Select
'刷新
MyObj.Update
Next prop
willj 发表于 2023-9-13 15:36
完美解决了，多谢指点
为什么我运行prop.value = val的时候会报错，从官网文档上看prop.value 是不能修改的 本帖最后由 willj 于 2023-9-12 10:20 编辑
chixun99 发表于 2023-9-11 12:33
dim vAtt as variant
vAtt = AttBlR.GetAttributes
If IsArray(vAtt) Then
Sub SetAttributeValue()
Dim objAcadApp As Object
Dim objAcadDoc As Object
Dim objBlockRef As Object
Dim objBlockRefs As Object
Dim strBlockName As String
Dim strAttributeName As String
Dim strAttributeValue As String
Dim blnBlockRefFound As Boolean
'连接到AutoCAD应用程序
On Error Resume Next
Set objAcadApp = GetObject(, "AutoCAD.Application")
If objAcadApp Is Nothing Then
Set objAcadApp = CreateObject("AutoCAD.Application")
End If
On Error GoTo 0
'检查是否连接到AutoCAD
If objAcadApp Is Nothing Then
MsgBox "无法连接到AutoCAD"
Exit Sub
End If
'获取当前打开的图档
Set objAcadDoc = objAcadApp.ActiveDocument
'检查是否打开了图档
If objAcadDoc Is Nothing Then
MsgBox "未打开图档"
Exit Sub
End If
'获取指定块参照对象的块名称、属性名称和属性值
strBlockName = "测试模块"
strAttributeName = "宽度"
strAttributeValue = "1400"
'遍历所有块参照对象并查找指定块参照对象
For Each objBlockRef In objBlockRefs
If objBlockRef.Name = strBlockName Then
blnBlockRefFound = True
'获取块参照对象的所有属性
Dim vAtt As Variant
vAtt = objBlockRef.GetAttributes
If IsArray(vAtt) Then
'遍历属性集合并查找标签(TagString)等于指定块名称(BlName)的属性
Dim i As Integer
For i = LBound(vAtt) To UBound(vAtt)
If vAtt(i).TagString = strAttributeName Then
'设置属性值(TextString)为指定的值(ValueStr)
vAtt(i).TextString = strAttributeValue
Exit For
End If
Next i
End If
Exit For
End If
Next objBlockRef
'提示块参照对象是否存在
If blnBlockRefFound Then
MsgBox "块参照对象存在"
Else
MsgBox "块参照对象不存在"
End If
End Sub
思路感觉是这样了。就是还有个报错不知道什么情况
在 excel编程不就行了 liuhe 发表于 2023-9-11 10:45
在 excel编程不就行了
可以出个示例学习下吗 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=186844&highlight=%CA%F4%D0%D4%BF%E9去这个连接找找我回复的代码参考。 chixun99 发表于 2023-9-11 11:32
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=186844&highlight=%CA%F4%D0%D4%BF%E9去这个连接找找我 ...
老师好，如果有时间是否可以帮我搞个示例。我查了下好像是需要用到GetDynamicBlockProperties方法去获取动态块的自定义属性，具体实现修改还未摸索出来。 dim vAtt as variant
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
就这段可以实现属性值的修改了？关键是要遍历所有你的图块图形，BlName 改为对应你的A列的名称，ValueStr改为对应你的B列的值 chixun99 发表于 2023-9-11 12:33
dim vAtt as variant
vAtt = AttBlR.GetAttributes
If IsArray(vAtt) Then
暂时无从下手 willj 发表于 2023-9-11 13:06
暂时无从下手
你会VBA吗？看你的帖子和帐号，很多年的账号了，但是没有一个代码 liuhe 发表于 2023-9-11 13:33
你会VBA吗？看你的帖子和帐号，很多年的账号了，但是没有一个代码
第一次连CAD进行操作 willj 发表于 2023-9-11 13:45
第一次连CAD进行操作
你要是真会vba直接查书就能解决的事情