创建匿名块
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
需要的复制哈 谢谢分享。 怎么在你的代码上面修改获取块的外框呢
页:
[1]