|
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
|