'*******************************************************************************************
'極坐標(biāo)標(biāo)注*****************************************************極坐標(biāo)標(biāo)注*********************
' 調(diào)用AddDimAlignedCTxt
Sub DimJZB()
Dim Pi As Double ' 圓周率
Pi = 3.14159265358973
'獲取線段各屬性
Dim jd As Variant '極坐標(biāo)角度
Dim BJ As Double '極坐標(biāo)半徑
Dim ZD(0 To 2) As Double '極坐標(biāo)半徑中點(diǎn)
Dim WS As Integer '輸入標(biāo)注精度
Dim JDGS As Integer '輸入角度格式
Dim D As Variant '選擇標(biāo)注點(diǎn)
'選擇極坐標(biāo)原點(diǎn)
Dim YD As Variant
On Error Resume Next
ThisDrawing.Utility.InitializeUserInput 1, ""
WS = ThisDrawing.Utility.GetInteger("輸入標(biāo)注精度(小數(shù)點(diǎn)后幾位數(shù)):")
'第一個(gè)參數(shù)設(shè)置為1以強(qiáng)制用戶輸入關(guān)鍵字,但不接受 NULL 輸入(即按 ENTER 鍵)
ThisDrawing.Utility.InitializeUserInput 0, "0 1 2"
'提示關(guān)鍵字供用戶選擇
JDGS = ThisDrawing.Utility.GetKeyword(vbCrLf & "角度格式[十進(jìn)制(0)/弧度制(1)]<度分秒(2)>:")
xNext:
On Error GoTo E:
D = ThisDrawing.Utility.GetPoint(, "選擇標(biāo)注點(diǎn):")
YD = ThisDrawing.Utility.GetPoint(D, "選擇極坐標(biāo)原點(diǎn):")
Dim XD As AcadLine
Set XD = ThisDrawing.ModelSpace.AddLine(YD, D)
jd = XD.angle
If JDGS = 0 Then
'將角度轉(zhuǎn)換成十進(jìn)制表示
jd = 180 * jd / Pi
jd = Format(jd, "0.0000")
ElseIf JDGS = 2 Then
'將角度轉(zhuǎn)換成十進(jìn)制表示
jd = 180 * jd / Pi
jd = Format(jd, "0.0000")
'將角度轉(zhuǎn)換成 度分秒
jd = jd * 3600
jd = jd \ 3600 & "%%d" & (jd \ 60) Mod 60 & "'" & jd Mod 60 & """"
Else
'仍然用弧度制表示 僅將精度控制在四位數(shù)
jd = Format(jd, "0.0000")
End If
'計(jì)算半徑長(zhǎng)度
BJ = Sqr(((D(0) - YD(0)) ^ 2 + (D(1) - YD(1)) ^ 2 + (D(2) - YD(2)) ^ 2))
'半徑標(biāo)注轉(zhuǎn)變精度
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
'計(jì)算中點(diǎn)坐標(biāo)
ZD(0) = (D(0) + YD(0)) / 2
ZD(1) = (D(1) + YD(1)) / 2
ZD(2) = (D(2) + YD(2)) / 2
'標(biāo)注
AddDimAlignedCTxt D, YD, ZD, "R=" & BJ & " A=" & jd
XD.Delete
GoTo xNext
E:
End Sub
'****************************************************************************************