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
'****************************************************************************************
'极坐标标注*****************************************************极坐标标注*********************
' 调用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
'****************************************************************************************
[本日志由 田草 于 2007-11-24 10:04 AM 编辑]
|
田草 于 2007-01-26 02:19 PM 发表评论:
最近这边活比较少,有空更新。
dylan_sue 于 2007-01-26 02:02 PM 发表评论:
CAD现在我已经不用了,几乎都快不会用了,哎!四年大学好象对我只是为了那张毕业证
发表评论 - 不要忘了输入验证码哦! |