AutoCAD ActiveX API 获取尺寸 代码案例

以下是一个使用AutoCAD ActiveX API获取尺寸的代码示例：

Option Explicit

Sub GetDimensions()
    '声明AutoCAD对象
    Dim acadApp As Object
    Dim acadDoc As Object
    Dim acadModelSpace As Object
    Dim acadSelectionSet As Object
    
    '声明变量
    Dim obj As Object
    Dim dimObj As AcadDimension
    Dim startPt As Variant
    Dim endPt As Variant
    Dim textPt As Variant
    Dim dimValue As Double
    
    '获取AutoCAD程序对象
    Set acadApp = GetObject(, "AutoCAD.Application")
    '获取当前文档对象
    Set acadDoc = acadApp.ActiveDocument
    '获取模型空间对象
    Set acadModelSpace = acadDoc.ModelSpace
    
    '创建选择集对象
    Set acadSelectionSet = acadDoc.SelectionSets.Add("MySelectionSet")
    '清空选择集
    acadSelectionSet.Clear
    '设置选择集过滤条件
    acadSelectionSet.Select acSelectionSetAll, , , Array(acDimAligned, acDimAngular, acDimDiametric, acDimRadial)
    
    '遍历选择集中的对象
    For Each obj In acadSelectionSet
        '判断对象是否为尺寸对象
        If TypeOf obj Is AcadDimension Then
            '获取尺寸对象
            Set dimObj = obj
            '获取尺寸的起点、终点和文字位置
            startPt = dimObj.ExtensionLine1Point
            endPt = dimObj.ExtensionLine2Point
            textPt = dimObj.DimensionLineLocation
            '计算尺寸值
            dimValue = dimObj.Measurement
            '输出尺寸信息
            Debug.Print "起点坐标: (" & startPt(0) & ", " & startPt(1) & ", " & startPt(2) & ")"
            Debug.Print "终点坐标: (" & endPt(0) & ", " & endPt(1) & ", " & endPt(2) & ")"
            Debug.Print "文字位置: (" & textPt(0) & ", " & textPt(1) & ", " & textPt(2) & ")"
            Debug.Print "尺寸值: " & dimValue
        End If
    Next
    
    '清空选择集
    acadSelectionSet.Clear
    '删除选择集对象
    acadSelectionSet.Delete
End Sub

这个代码示例中，我们首先获取了AutoCAD程序对象、当前文档对象和模型空间对象。然后创建了一个选择集对象，设置了选择集过滤条件，遍历选择集中的对象，判断是否为尺寸对象，如果是，就获取尺寸的起点、终点、文字位置和尺寸值，并输出到调试窗口。最后清空选择集并删除选择集对象