CAD 画直线

最新推荐文章于 2024-11-02 15:22:06 发布

墨家前任巨子

最新推荐文章于 2024-11-02 15:22:06 发布

阅读量146

点赞数

分类专栏： CAD学习文章标签：学习

本文链接：https://blog.csdn.net/qq_39728950/article/details/129689676

版权

CAD学习专栏收录该内容

9 篇文章 2 订阅

订阅专栏

这段代码展示了如何在VBA中使用AutoCADAPI创建线段（AcadLine）。首先，定义变量并获取用户指定的两点坐标，然后使用这些坐标添加线段到模型空间，并更新线段。此外，还定义了一个GetPoint函数，用于交互式获取CAD坐标点。

摘要由CSDN通过智能技术生成

    Dim Inp1 As Variant, Inp2 As Variant
    Dim LinX As AcadLine


                '获取起点
    Inp1 = GetPoint("请指定PIN1的起点：")
    If IsEmpty(Inp1) Then Exit For
    Inp2 = GetPoint("请指定PIN2的终点：", Val(Inp1(0)), Val(Inp1(1)))
    If IsEmpty(Inp2) Then Exit For
    Set LinX = acadApp.ActiveDocument.ModelSpace.AddLine(Inp1, Inp2)

    LinX.Update


'获取 CAD的坐标点
Public Function GetPoint(Prompt As String, Optional BasePntX As Double = 0, Optional BasePntY As Double = 0) As Variant
    On Error GoTo Err_GetPoint
    Dim P1(0 To 2) As Double
    If BasePntX = 0 And BasePntY = 0 Then    '没有第1点
        GetPoint = acadApp.ActiveDocument.Utility.GetPoint(, Prompt)
    Else
        P1(0) = BasePntX: P1(1) = BasePntY
        GetPoint = acadApp.ActiveDocument.Utility.GetPoint(P1, Prompt)
    End If
    Exit Function
Err_GetPoint:
End Function