VB编程操作AutoCAD块对象

块对象指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