CADvba来个炸属性快的思路，不知道思路是否正确。

‘自己解决了。代码来了已测试。----------------------
Sub 炸属性块()
Dim ss As AcadSelectionSet '选择集
Dim ssbl As AcadSelectionSet '选择集
Dim bl As AcadBlockReference '块引用（块插入）
Dim acEn As AcadEntity '图元对象
Dim acTxt As AcadText '文本对象
Dim arAtt As Variant '块属性数组
Dim arP As Variant '插入点变量数组
Dim Xsc As Double 'x块比例
Dim Ysc As Double 'y块比例
Dim Zsc As Double 'z轴比例
Dim AnRotate As Double '块旋转角度
Dim iP(2) As Double '块插入点
Dim aP(2) As Double '块属性参照点
Dim strAttributes As String '属性文字串
Dim i As Integer '计数器
Dim strTag As String '文本标签
Set ss = newSel_set("aBlock")
ThisDrawing.Utility.Prompt "选择一个属性块插入:"
ss.SelectOnScreen
If ThisDrawing.ActiveSpace = acPaperSpace Then MsgBox "请在模型空间选择块"
If ss.Count > 0 Then
If ss(0).ObjectName = Dr17 Then
'================================================================
'========这里还在想怎么能把属性块炸开又能保留原来的属性值内容。=====
'========先用字典记录所有属性值对应属性名称然后在原来位置填写文字===
'========所有属性遍历完后，删除属性块=============================
'================================================================
'读取块参照的插入点、缩放比例、选择角度
Set bl = ss(0)
arAtt = bl.InsertionPoint '读取插入点到变量
iP(0) = arAtt(0): iP(1) = arAtt(1): iP(2) = arAtt(2)
AnRotate = bl.Rotation
Xsc = bl.XScaleFactor: Ysc = bl.YScaleFactor: Zsc = bl.ZScaleFactor
'读块属性参照的成员信息
arAtt = bl.GetAttributes '读取块属性到变量
If UBound(arAtt) >= 0 Then
For i = LBound(arAtt) To UBound(arAtt)
With arAtt(i)
If .TextString <> "" And Not (.Invisible) Then '内容文字串不为空且非隐藏属性
Set acTxt = ThisDrawing.ModelSpace.AddText(.TextString, iP, .Height) '添加文字在插入点设置字高
acTxt.Alignment = .Alignment '对齐方式
acTxt.Backward = .Backward '正向 / 反向
acTxt.ScaleFactor = .ScaleFactor '字宽比例
acTxt.Layer = .Layer '图层
acTxt.ObliqueAngle = .ObliqueAngle '倾斜角
acTxt.Rotation = .Rotation '旋转
acTxt.StyleName = .StyleName '样式名
acTxt.TrueColor = .TrueColor '颜色
acTxt.UpsideDown = .UpsideDown '颠倒
strTag = .TagString '标签文字串
'arP = .InsertionPoint '插入点坐标
arP = .TextAlignmentPoint '对齐点坐标
aP(0) = arP(0) + iP(0): aP(1) = arP(1) + iP(1): aP(2) = arP(2) + iP(2)
Call acTxt.Move(iP, aP)
End If
End With
'strAttributes = strAttributes & vbLf & " Tag: " & arAtt(i).TagString & _
' vbLf & " Value: " & arAtt(i).TextString & vbLf & " "
Next
'MsgBox "The attributes for blockReference " & bl.Name & " are: " & strAttributes, , "GetAttributes Example"
Else
Debug.Print "块没有定义属性。"
End If
'炸开块参照并删除其中炸开的图形中属于属性定义的图元，并最后删除选定的块
'Set ssbl = newSel_set("arBlen")
arP = bl.Explode
If UBound(arP) > 0 Then
For i = UBound(arP) To 0 Step -1
'Debug.Print arP(i).ObjectName
If arP(i).ObjectName = Dr17 Or arP(i).ObjectName = Dr18 Then
arP(i).Delete
End If
Next i
End If
ss(0).Delete
Else
Debug.Print "选择图形不是图块。"
End If
Else
Debug.Print "未选择图块"
End If
End Sub

写了一段测试用代码，看下边
Sub tt()
Dim aRange As Variant
aRange = Range("a1:d9")
Dim i As Long, j As Long
For i = 1 To 9
For j = 1 To 4
aRange(i, j) = aRange(i, j) + j
Next
Next
Range("a1:d9") = aRange
End Sub

请教楼主一个问题啊
我用代码的方式创建了 一个选择集
如何选中 这个选择集 里面的所有图形，代码也行 或者 CAD里面手工操作也行。

再问一个问题，如何通过VBA代码 修改所有块里面的图形的颜色为 Byblock

先在这里简单回复一下“代码的方式创建了 一个选择集，如何选择？”，
1，新建的选择集后，全选其中的图元需要用到lisp的函数来实现，首先循环遍历选集里的图元，把图元的句柄获得。2，然后转为字符串，用“xxx 句柄字符串"的格式来指代某个图元，用循环把所有图元字符串所有连接为一个整的字符串。3，使用lisp函数来操作这个字符串进行选择，这一步也可以使用另一种方式是通过cad命令发送到命令行进行选择。格式是”select xxx句柄字符串“。