以下文字来自于 weixin_34183910的博客https://blog.csdn.net/weixin_34183910/article/details/85489135
块对象指Blocks集合对象和Block对象,Blocks对象包含一个图形文档中的所有命名的图块,Block对象则包含构成一个图块的所有实体对象,块对象的创建与引用包含3个步骤:用块对象的Add方法创建一个命名块,向块对象添加实体,用InsertBlock方法将该块插入到任何地方,即引用块。
下面的代码创建一个块对象,并向块中添加一个圆,然后在不同位置插入该块对象。
Private Sub Command1_Click()
Dim blockobj As AcadBlock
Dim insertionpnt(0 To 2) As Double
insertionpnt(0) = 0#: insertionpnt(1) = 0#: insertionpnt(2) = 0#
Set blockojb = acadapp.ActiveDocument.Blocks.Add(insertionpnt, "circleblock")
Dim circleobj As AcadCircle
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 0: center(1) = 0: center(2) = 0
radius = 1
Set circleobj = blockobj.AddCircle(center, radius)
Dim blockrefobj As AcadBlockReference
Set blockrefobj = acadapp.ActiveDocument.ModelSpace.InsertBlock(insertionpnt, "circleblock", 1#, 1#, 1#, 0)
insertionpnt(0) = 5#: insertionpnt(1) = 2#: insertionpnt(2) = 0
Set blockrefobj = acadapp.ActiveDocument.ModelSpace.InsertBlock(insertionpnt, "Circleblock", 1#, 1#, 1#, 0)
ZoomExtents
End Sub
当实体对象行程块,插入文档形成块引用时,可以用Explode方法将其炸开,重新获得单独的实体对象,然后就可以对块对象进行修改,或者添加、删除组成的实体对象。下面的代码创建一个块对象,想块中添加两个同心圆,将块对象插入文档形成引用对象,然后炸开块,改变两个同心圆的颜色,再删除块引用和第一个圆。
Private Sub Command1_Click()
Dim blockobj As AcadBlock
Dim insertionpnt(0 To 2) As Double
insertionpnt(0) = 0
insertionpnt(1) = 0
insertionpnt(2) = 0
Set blockobj = acadapp.ActiveDocument.Blocks.Add(insertionpnt, "circleblock")
Dim circleobj1 As AcadCircle
Dim circleobj2 As AcadCircle
Dim center(0 To 2) As Double
center(0) = 0
center(1) = 0
center(2) = 0
Set circleobj1 = blockobj.AddCircle(center, 1)
Set circleobj2 = blockobj.AddCircle(center, 3)
Dim blockrefobj As AcadBlockReference
insertionpnt(0) = 2
insertionpnt(1) = 2
insertionpnt(2) = 0
Set blockrefobj = acadapp.ActiveDocument.ModelSpace.InsertBlock(insertionpnt, "circleblock", 1#, 1#, 1#, 0)
ZoomExtents
MsgBox "图形"
Dim explodedobjects As Variant //仅获取分解对象,不删除原参照
explodedobjects = blockrefobj.Explode
Dim i As Integer
For i = 0 To UBound(explodedobjects)
MsgBox "炸开"
explodedobjects(i).Color = acRed
explodedobjects(i).Update
Next
blockrefobj.Delete
explodedobjects(0).Delete //最好删除分解对象
End Sub
用AddAttribute方法可以创建块属性对象,块的属性可以给块添加文字,用来显示块的相关信息,将带有属性的块插入文档,创建一个块引用对象,可以从该块引用中提取并修改块属性信息,下面的代码创建一个块对象,向块对象中添加一个圆,然后创建块属性对象,再插入块,创建块引用对象,提取该对象引用属性并在消息框中显示属性标记,然后修改块属性,再次提取块引用属性并再消息框中显示属性标记和属性值。
Private Sub Command1_Click()
Dim blockobj As AcadBlock
Dim insertionpnt(0 To 2) As Double
insertionpnt(0) = 0
insertionpnt(1) = 0
insertionpnt(2) = 0
Set blockobj = acadapp.ActiveDocument.Blocks.Add(insertionpnt, "testblock")
Dim circleobj As AcadCircle
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 0: center(1) = 0: center(2) = 0
radius = 5
Set circleobj = blockobj.AddCircle(center, radius)
Dim attributeobj As AcadAttribute
Dim height As Double
Dim mode As Long
Dim prompt As String
Dim insertionpoint(0 To 2) As Double
Dim tag As String
Dim value As String
height = 1#
mode = acAttributeModeVerify
prompt = "attribute prompt"
insertionpoint(0) = 1
insertionpoint(1) = 1
insertionpoint(2) = 0
tag = "attribute tag"
value = "attribute value"
Set attributeobj = blockobj.AddAttribute(height, mode, prompt, insertionpoint, tag, value)
Dim blockrefobj As AcadBlockReference
insertionpnt(0) = 2
insertionpnt(1) = 2
insertionpnt(2) = 0
Set blockrefobj = acadapp.ActiveDocument.ModelSpace.InsertBlock(insertionpnt, "testblock", 1, 1, 1, 0)
ZoomExtents
Dim varattributes As Variant
varattributes = blockrefobj.GetAttributes
Dim strattributes As String
strattributes = ""
Dim i As Integer
For i = LBound(varattributes) To UBound(varattributes)
strattributes = strattributes + "tag:" + varattributes(i).TagString + vbCrLf + "value:" + varattributes(i).TextString
Next
MsgBox "引用"
varattributes(0).TextString = "NEW VALUE"
varattributes(0).Update
Dim newvarattributes As Variant
newvarattributes = blockrefobj.GetAttributes
strattributes = ""
For i = LBound(varattributes) To UBound(varattributes)
strattributes = strattributes + "Tag:" + newvarattributes(i).TagString + vbCrLf + "value:" + newvarattributes(i).TextString
Next
MsgBox "块引用:"
End Sub