CAD VBA 极坐标标注

'*******************************************************************************************

'极坐标标注*****************************************************极坐标标注*********************
'   调用AddDimAlignedCTxt
Sub DimJZB()
    Dim Pi As Double ' 圆周率
    Pi = 3.14159265358973
    '获取线段各属性
    Dim jd  As Variant '极坐标角度
    Dim BJ  As Double   '极坐标半径
    Dim ZD(0 To 2)  As Double  '极坐标半径中点
    Dim WS As Integer '输入标注精度
    Dim JDGS As Integer '输入角度格式
    Dim D As Variant '选择标注点
    '选择极坐标原点
    Dim YD  As Variant

    On Error Resume Next
    ThisDrawing.Utility.InitializeUserInput 1, ""
    WS = ThisDrawing.Utility.GetInteger("输入标注精度(小数点后几位数):")
    '第一个参数设置为1以强制用户输入关键字,但不接受 NULL 输入（即按 ENTER 键）
    ThisDrawing.Utility.InitializeUserInput 0, "0 1 2"
    '提示关键字供用户选择
    JDGS = ThisDrawing.Utility.GetKeyword(vbCrLf & "角度格式[十进制(0)/弧度制(1)]<度分秒(2)>:")
   
xNext:
    On Error GoTo E:

    D = ThisDrawing.Utility.GetPoint(, "选择标注点：")

    YD = ThisDrawing.Utility.GetPoint(D, "选择极坐标原点：")

    Dim XD As AcadLine
    Set XD = ThisDrawing.ModelSpace.AddLine(YD, D)
    jd = XD.angle
    If JDGS = 0 Then
        '将角度转换成十进制表示
        jd = 180 * jd / Pi
        jd = Format(jd, "0.0000")
    ElseIf JDGS = 2 Then
        '将角度转换成十进制表示
        jd = 180 * jd / Pi
        jd = Format(jd, "0.0000")
        '将角度转换成 度分秒
        jd = jd * 3600
        jd = jd \ 3600 & "%%d" & (jd \ 60) Mod 60 & "'" & jd Mod 60 & """"
    Else
        '仍然用弧度制表示 仅将精度控制在四位数
        jd = Format(jd, "0.0000")
    End If
    '计算半径长度
    BJ = Sqr(((D(0) - YD(0)) ^ 2 + (D(1) - YD(1)) ^ 2 + (D(2) - YD(2)) ^ 2))
    '半径标注转变精度
    Select Case WS
      Case 0
        BJ = Int(BJ)
      Case 1
        BJ = Int(BJ * 10) / 10
      Case 2
        BJ = Int(BJ * 100) / 100
      Case 3
        BJ = Int(BJ * 1000) / 1000
      Case 4
        BJ = Int(BJ * 10 ^ 4) / 10 ^ 4
      Case 5
        BJ = Int(BJ * 10 ^ 5) / 10 ^ 5
      Case 6
        BJ = Int(BJ * 10 ^ 6) / 10 ^ 6
      Case 7
        BJ = Int(BJ * 10 ^ 7) / 10 ^ 7
      Case 8
        BJ = Int(BJ * 10 ^ 8) / 10 ^ 8
      Case 9
        BJ = Int(BJ * 10 ^ 9) / 10 ^ 9
    End Select

    '计算中点坐标
    ZD(0) = (D(0) + YD(0)) / 2
    ZD(1) = (D(1) + YD(1)) / 2
    ZD(2) = (D(2) + YD(2)) / 2

    '标注
    AddDimAlignedCTxt D, YD, ZD, "R=" & BJ & " A=" & jd
    XD.Delete
    GoTo xNext
E:
End Sub
'****************************************************************************************