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("輸入標注精度(小數(shù)點后幾位數(shù)):")
    '第一個參數(shù)設置為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
        '仍然用弧度制表示 僅將精度控制在四位數(shù)
        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
'****************************************************************************************