创建匿名块

QWQWQWQ

Option Explicit

' 创建匿名块
Public Sub CreateAnonymousBlk()
    Dim ptBase(0 To 2) As Double
    ptBase(0) = 0: ptBase(1) = 0: ptBase(2) = 0

    ' 添加块定义
    Dim objBlkDef As AcadBlock
    Set objBlkDef = ThisDrawing.Blocks.Add(ptBase, "*U")

    ' 向块定义中添加图形对象
    Dim pt1(0 To 2) As Double
    Dim pt2(0 To 2) As Double
    pt1(0) = -10: pt1(1) = 0: pt1(2) = 0
    pt2(0) = 10: pt2(1) = 0: pt2(2) = 0
    objBlkDef.AddLine pt1, pt2

    pt1(0) = 0: pt1(1) = -10: pt1(2) = 0
    pt2(0) = 0: pt2(1) = 10: pt2(2) = 0
    objBlkDef.AddLine pt1, pt2

    objBlkDef.AddCircle ptBase, 6
End Sub

' 获得最后创建的匿名块
Public Function GetLastAnonymousBlk() As AcadBlock
    Dim objBlkDef As AcadBlock
    Dim n As Integer

    For Each objBlkDef In ThisDrawing.Blocks
        ' 匿名块以*为起始字符
        If Left(objBlkDef.Name, 1) = "*" Then
            ' 消除布局块的影响
            If objBlkDef.Name <> "*Model_Space" And Left(objBlkDef.Name, 12) <> "*Paper_Space" Then
                ' 返回名称编号最大的一个块
                If Mid(objBlkDef.Name, 3) >= n Then
                    n = Mid(objBlkDef.Name, 3)
                    Set GetLastAnonymousBlk = objBlkDef
                End If
            End If
        End If
    Next

    Set objBlkDef = Nothing
End Function

' 插入一个匿名块
Public Sub InsertAnonymousBlkRef()
    Dim ptInsert(0 To 2) As Double
    ptInsert(0) = 100: ptInsert(1) = 100: ptInsert(2) = 0

    Dim objBlk As AcadBlock
    ' 获得图形中最后一个创建的匿名块
    Set objBlk = GetLastAnonymousBlk
    ThisDrawing.ModelSpace.InsertBlock ptInsert, objBlk.Name, 1, 1, 1, 0
End Sub

' 获得图形中匿名块的数量和名称
Public Sub GetAnonymousBlkNumber()
    Dim objBlkDef As AcadBlock
    Dim n As Integer                    ' 匿名块的数量

    For Each objBlkDef In ThisDrawing.Blocks
        ' 匿名块以*为起始字符
        If Left(objBlkDef.Name, 1) = "*" Then
            ' 消除布局块的影响
            If objBlkDef.Name <> "*Model_Space" And Left(objBlkDef.Name, 12) <> "*Paper_Space" Then
                n = n + 1
                Debug.Print objBlkDef.Name
            End If
        End If
    Next

    MsgBox "当前图形中匿名块的数量是： " & CStr(n)
End Sub

QWQWQWQ

需要的复制哈

中国梦

谢谢分享。

787116960

怎么在你的代码上面修改获取块的外框呢