AutoCAD VBA标注圆弧长度

AutoCAD VBA标注圆弧长度，代码如下。

Public Sub DimArcLeng()
Dim Arc As AcadArc
Dim Pnt As Variant
Err.Clear
On Error Resume Next
ThisDrawing.Utility.GetEntity Arc, Pnt, "请选择圆弧："
If Err.Number <> 13 And Err.Number <> 0 Then Exit Sub
Do Until Arc.ObjectName = "AcDbArc"
Err.Clear
ThisDrawing.Utility.GetEntity Arc, Pnt, "你所选的不是圆弧，请重新选择圆弧："
If Err.Number <> 13 And Err.Number <> 0 Then Exit Sub
Loop
Dim Leng As Double
Dim SPnt As Variant
Dim EPnt As Variant
Dim CPnt As Variant
Leng = Arc.ArcLength
SPnt = Arc.StartPoint
EPnt = Arc.EndPoint
CPnt = Arc.Center
Dim PntforDim As Variant
PntforDim = ThisDrawing.Utility.GetPoint(, "选择标注点的位置：")
Dim DimAng As AcadDim3PointAngular
Set DimAng = ThisDrawing.ModelSpace.AddDim3PointAngular(CPnt, SPnt, EPnt, PntforDim)
Dim FormatDot As Integer
Dim FormatTxt As String
FormatDot = DimAng.TextPrecision
FormatTxt = "0"
Dim I As Integer
For I = 0 To FormatDot
If I > 1 Then
FormatTxt = FormatTxt & "0"
Else
FormatTxt = FormatTxt & ".0"
End If
Next
DimAng.TextOverride = "{\Fgdt.shx;^}\p" & Format(Leng, FormatTxt)
End Sub

代码完。

CAD2006之后就可以直接标注圆弧长度了。