调整 AutoCAD VBA 以在 Excel 中工作答案

【问题标题】：Adapt AutoCAD VBA to work in Excel调整 AutoCAD VBA 以在 Excel 中工作
【发布时间】：2019-03-22 05:48:22
【问题描述】：

我已经编写了一个在 AutoCAD VBA 中工作的代码（在帮助下），但我想对其进行调整，以便可以从 Excel 运行它并将其集成到更长的宏中。我试过用ACAD.ActiveDocument 替换ThisDrawing，但这不起作用。这是我的完整 AutoCAD VBA 代码：

Public Sub Section()
    Dim SolidObject As Acad3DSolid
    Dim NewRegionObject As AcadRegion
    Dim PlaneOrigin As Variant
    Dim PlaneXaxisPoint As Variant
    Dim PlaneYaxisPoint As Variant
    Dim PickedPoint As Variant
    On Error Resume Next
    With ThisDrawing.Utility
        .GetEntity SolidObject, PickedPoint, vbCr & "Select solid to cut."
        If Err Then
            MsgBox "Selected solid must be a 3DSolid"
            Exit Sub
        End If
        PlaneOrigin = .GetPoint(PickedPoint, vbCr & "Select point to define origin.")
        PlaneXaxisPoint = .GetPoint(PickedPoint, vbCr & "Select point to define x-axis.")
        PlaneYaxisPoint = .GetPoint(PickedPoint, vbCr & "Select point to define y-axis.")
        Dim minPoint As Variant, maxPoint As Variant
        Set NewRegionObject = SolidObject.SectionSolid(PlaneOrigin, PlaneXaxisPoint, PlaneYaxisPoint)
        With NewRegionObject
            MsgBox "Area: " & .Area
            MsgBox "Perimeter: " & .Perimeter

            .GetBoundingBox minPoint, maxPoint
            MsgBox "Min Point coordinates: (" & minPoint(0) & "," & minPoint(1) & "," & minPoint(2) & ")"
            MsgBox "Max Point coordinates: (" & maxPoint(0) & "," & maxPoint(1) & "," & maxPoint(2) & ")"
        End With
    End With
End Sub

【问题讨论】：

如果您调用的对象在 excel 中可用，您应该查看 MSDN 文档。例如 SolidObject 和 NewRegionObject
首先，您是否将 AutoCad 库加载到您的 VBA 项目中？
是的，我加载了它

标签： excel autocad vba

【解决方案1】：

您可以使用此函数查看是否有正在运行的 AutoCad 实例，如果有，获取它：

Function Set_Acad(Acad As AcadApplication) As Boolean
    On Error Resume Next
    Set Acad = GetObject(, "AutoCAD.Application") 'Get a running instance of the class AutoCAD.Application
    On Error GoTo 0
    Set_Acad = Not Acad Is Nothing
End Function

在你的主代码中被利用如下：

Option Explicit

Public Sub Section()
    Dim SolidObject As Acad3DSolid
    Dim NewRegionObject As AcadRegion
    Dim PlaneOrigin As Variant
    Dim PlaneXaxisPoint As Variant
    Dim PlaneYaxisPoint As Variant
    Dim PickedPoint As Variant

    Dim Acad As AcadApplication '<--| declare a variable of type 'AcadApplication'

    If Not Set_Acad(Acad) Then Exit Sub '<--| exit if there's no Autocad running instance, otehrwise set 'Acad' variable to it

    With Acad.ActiveDocument.Utility '<--| now you can use Acad to reference 'Autocad' application and all its objects/methods/properties

        On Error Resume Next
       .GetEntity SolidObject, PickedPoint, vbCr & "Select solid to cut."
        If Err Then
            MsgBox "Selected solid must be a 3DSolid"
            Set Acad = Nothing
            Exit Sub
        End If
        On Error GoTo 0

        PlaneOrigin = .GetPoint(PickedPoint, vbCr & "Select point to define origin.")
        PlaneXaxisPoint = .GetPoint(PickedPoint, vbCr & "Select point to define x-axis.")
        PlaneYaxisPoint = .GetPoint(PickedPoint, vbCr & "Select point to define y-axis.")
        Dim minPoint As Variant, maxPoint As Variant
        Set NewRegionObject = SolidObject.SectionSolid(PlaneOrigin, PlaneXaxisPoint, PlaneYaxisPoint)
        With NewRegionObject
            MsgBox "Area: " & .area
            MsgBox "Perimeter: " & .Perimeter

            .GetBoundingBox minPoint, maxPoint
            MsgBox "Min Point coordinates: (" & minPoint(0) & "," & minPoint(1) & "," & minPoint(2) & ")"
            MsgBox "Max Point coordinates: (" & maxPoint(0) & "," & maxPoint(1) & "," & maxPoint(2) & ")"
        End With
    End With

    Set Acad = Nothing    
End Sub

【讨论】：

【解决方案2】：

在 AutoCAD 中从 Excel 创建一行（必须打开）
但是你必须进入Tools->References并添加[AutoCAD 20xx Type Library]

    Sub testline()
    Dim app
    Dim lineObj As AcadLine
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double

    On Error Resume Next
        Set app = GetObject(, "AutoCAD.Application")
    On Error GoTo 0

    If (app Is Nothing) Then Exit Sub

    startPoint(0) = 100
    startPoint(1) = 100
    startPoint(2) = 0
    endPoint(0) = 200
    endPoint(1) = 200
    endPoint(2) = 0

    Set lineObj = app.Documents(0).ModelSpace.AddLine(startPoint, endPoint)

End Sub

【讨论】：