AutoCAD VBA 获取单个转角标注的相关数据。

AutoCAD VBA 获取单个转角标注的相关数据。@TOC

菜鸟献丑了，请多指教！
这是一个在AutoCAD VBA中获取转角标注关键点数据的方法。
DXF不会弄，只能用这个土方法。不是很标准规范，但可以应应急！

Option Explicit
Type DimData
topLeftPt(0 To 2) As Double '转角尺寸标注的矩形框左上角坐标。
topRightPt(0 To 2) As Double '转角尺寸标注的矩形框右上角坐标。
BtmLeftPt(0 To 2) As Double '转角尺寸标注的矩形框左下角坐标。
BtmRightPt(0 To 2) As Double '转角尺寸标注的矩形框右下角坐标。
Center(0 To 2) As Double '转角尺寸标注的矩形框中心坐标。
WIDTH As Double '转角尺寸标注的矩形框宽度。
TextPt(0 To 2) As Double '转角尺寸标注的文字原点坐标。
stText As String '转角尺寸标注的文本替代内容。
vDim As Double '转角尺寸标注的测量值。
End Type

'测试获取单个转角标注的相关数据。
Public Sub TestGetOneDimData()
Dim en As AcadEntity
Dim dd As DimData
Dim vp As Variant

ThisDrawing.Utility.GetEntity en, vp, "选择一个转角标注！"
    
GetOneDimData en, dd    '获取单个转角标注的相关数据。

Debug.Print dd.stText

End Sub

'获取单个转角标注的相关数据。
Private Sub GetOneDimData(Dm As AcadDimRotated, dd As DimData)
Dim en As AcadEntity
Dim DIM1 As AcadDimRotated
Dim vp As Variant
Dim minP, maxP As Variant
Dim st As String
Dim sp(0 To 2) As Double
Dim ep(0 To 2) As Double
Dim eo As Double
Dim ee As Double
Dim D1S As Boolean
Dim D2S As Boolean

Set DIM1 = Dm.Copy

vp = DIM1.TextPosition
Common.VpToSp vp, dd.TextPt
eo = DIM1.ExtensionLineOffset
DIM1.ExtensionLineOffset = 0    '引线脚点偏置量（间隙量）。
ee = DIM1.ExtensionLineExtend
DIM1.ExtensionLineExtend = 0    '引线超出尺寸线的距离。
D1S = DIM1.DimLine1Suppress
DIM1.DimLine1Suppress = True    '抑制第一尺寸线。
D2S = DIM1.DimLine2Suppress
DIM1.DimLine2Suppress = True    '抑制第二尺寸线。
st = DIM1.TextOverride          '获取现有替换文本的内容。
DIM1.TextOverride = " "         '将替换文本的内容修改为空格后，下面的获取边框命令不受文本高度影响。
DIM1.GetBoundingBox minP, maxP  '获得两根引线构成的矩形框。
DIM1.Delete
    
dd.topLeftPt(0) = minP(0): dd.topLeftPt(1) = maxP(1): dd.topLeftPt(2) = minP(2)
dd.topRightPt(0) = maxP(0): dd.topRightPt(1) = maxP(1): dd.topRightPt(2) = maxP(2)
dd.BtmLeftPt(0) = minP(0): dd.BtmLeftPt(1) = minP(1): dd.BtmLeftPt(2) = minP(2)
dd.BtmRightPt(0) = maxP(0): dd.BtmRightPt(1) = minP(1): dd.BtmRightPt(2) = maxP(2)
dd.WIDTH = Abs(dd.topLeftPt(0) - dd.topRightPt(0))
dd.Center(0) = dd.topLeftPt(0) + (dd.topRightPt(0) - dd.topLeftPt(0)) / 2
dd.Center(1) = dd.BtmLeftPt(1) + (dd.topLeftPt(1) - dd.BtmLeftPt(1)) / 2
If InStr(1, st, "<>") > 0 Then st = Replace(st, "<>", "")
dd.stText = st

’ '调试：绘制获取的四个角点的连线，判断获取效果。
’ Set en = ThisDrawing.ModelSpace.AddLine(minP, maxP)
’ en.Update
’ Set en = ThisDrawing.ModelSpace.AddLine(DD.BtmLeftPt, DD.topRightPt)
’ en.Update
’ Set en = ThisDrawing.ModelSpace.AddLine(DD.topLeftPt, DD.BtmRightPt)
’ en.Update
’ Set en = ThisDrawing.ModelSpace.AddCircle(DD.Center, 3)
’ en.Update
End Sub