[VBA]：类似录制宏的VBA代码示例。

第一步，引用：Microsoft Visual Basic for Applications Extensibility 5.3类型库，这是用于扩展VBA功能的组件。
第二步，在ThisDraiwntg中添加事件的监控，主要有对象的增加、修改、删除操作。以下只检测对象的创建，也只对直张的创建进行监控，当直线创建时，自动往工程中添加一个过程。
Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
    Select Case Object.ObjectName
        Case "AcDbLine"
            Dim lineObj As AcadLine
            Set lineObj = Object
            Dim ComponentObj As VBComponent
            Set ComponentObj = GetVBComponent(vbext_ct_StdModule)
            If ComponentObj Is Nothing Then
                Set ComponentObj = Application.VBE.ActiveVBProject.VBComponents.Add(vbext_ct_StdModule)
            End If
            With ComponentObj.CodeModule
                Dim s As String
                s = "" & vbCrLf
                s = "Sub 宏_Line" & GetProcCount(ComponentObj.CodeModule) + 1 & "()" & vbCrLf
                s = s & "" & vbCrLf
                s = s & "    ' 宏_Line" & GetProcCount(ComponentObj.CodeModule) + 1 & vbCrLf
                s = s & "    ' efan2000 记录的宏" & vbCrLf
                s = s & "" & vbCrLf
                s = s & "    Dim lineObj As AcadLine" & vbCrLf
                s = s & "    Dim startPoint(0 To 2) As Double" & vbCrLf
                s = s & "    Dim endPoint(0 To 2) As Double" & vbCrLf
                s = s & "" & vbCrLf
                s = s & "    ' 定义直线的起点和终点" & vbCrLf
                s = s & "    startPoint(0) = " & lineObj.startPoint(0) & ": startPoint(1) =  " & lineObj.startPoint(1) & ": startPoint(2) = 0" & vbCrLf
                s = s & "    endPoint(0) = " & lineObj.endPoint(0) & ": endPoint(1) = " & lineObj.endPoint(1) & ": endPoint(2) = 0" & vbCrLf
                s = s & "" & vbCrLf
                s = s & "    ' 在模型空间创建直线" & vbCrLf
                s = s & "    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)" & vbCrLf
                s = s & "    Set lineObj = Nothing" & vbCrLf
                s = s & "End Sub" & vbCrLf
                .InsertLines .CountOfLines + 1, s
            End With
    End Select
End Sub
'返回当前工程的第一个模块
Public Function GetVBComponent(ByVal ComponentType As vbext_ComponentType) As VBComponent
    Dim i As Integer
    For i = 1 To Application.VBE.ActiveVBProject.VBComponents.Count
        If Application.VBE.ActiveVBProject.VBComponents(i).Type = ComponentType Then
            Set GetVBComponent = Application.VBE.ActiveVBProject.VBComponents(i)
            Exit For
        End If
    Next
End Function
'返回模块中的过程数目
Public Function GetProcCount(ByVal CMObj As CodeModule) As Integer
    Dim i As Integer
    Dim s  As String
    For i = 1 To CMObj.CountOfLines
        If InStr(1, s, CMObj.ProcOfLine(i, vbext_pk_Proc), vbTextCompare) = 0 Then
            s = s & CMObj.ProcOfLine(i, vbext_pk_Proc) & ";"
        End If
    Next
    If s = "" Then Exit Function
    s = Left(s, Len(s) - 1)
    Dim v As Variant
    v = Split(s, ";")
    If Not IsEmpty(v) Then
        GetProcCount = UBound(v) + 1
    End If
End Function
第三步，这是在事件中自动创建的代码结果。
Sub 宏_Line1()
    ' 宏_Line1
    ' efan2000 记录的宏
    Dim lineObj As AcadLine
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double
    ' 定义直线的起点和终点
    startPoint(0) = 83.7160125997048: startPoint(1) = 206.265137503404: startPoint(2) = 0
    endPoint(0) = 259.874137686561: endPoint(1) = 243.32201842691: endPoint(2) = 0
    ' 在模型空间创建直线
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    Set lineObj = Nothing
End Sub
Sub 宏_Line2()
    ' 宏_Line2
    ' efan2000 记录的宏
    Dim lineObj As AcadLine
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double
    ' 定义直线的起点和终点
    startPoint(0) = 259.874137686561: startPoint(1) = 243.32201842691: startPoint(2) = 0
    endPoint(0) = 158.433236658299: endPoint(1) = 136.511009275691: endPoint(2) = 0
    ' 在模型空间创建直线
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    Set lineObj = Nothing
End Sub
Sub 宏_Line3()
    ' 宏_Line3
    ' efan2000 记录的宏
    Dim lineObj As AcadLine
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double
    ' 定义直线的起点和终点
    startPoint(0) = 158.433236658299: startPoint(1) = 136.511009275691: startPoint(2) = 0
    endPoint(0) = 328.59216866062: endPoint(1) = 155.039449391691: endPoint(2) = 0
    ' 在模型空间创建直线
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    Set lineObj = Nothing
End Sub
这仅仅是一个简单的功能，如果能够加以扩充，完全可以实现如在Excel中的录制宏的效果。