求弧长标注

ningyong58

已知直径和弧长画弧，并标注弧长。谢谢。

兰州人

见http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=666标注圆弧长度

2. Sub DimArcLeng()
4. Dim Arc As AcadArc
5. Dim Pnt As Variant
6. Err.Clear
7. On Error Resume Next
9. '选择圆弧
10. ThisDrawing.Utility.GetEntity Arc, Pnt, "请选择圆弧："
11. If Err.Number <> 13 And Err.Number <> 0 Then Exit Sub
13. Do Until Arc.ObjectName = "AcDbArc"
14. Err.Clear
15. ThisDrawing.Utility.GetEntity Arc, Pnt, "你所选的不是圆弧，请重新选择圆弧："
16. If Err.Number <> 13 And Err.Number <> 0 Then Exit Sub
17. Loop
19. '获取圆弧各属性
20. Dim Leng As Double
21. Dim SPnt As Variant
22. Dim EPnt As Variant
23. Dim CPnt As Variant
24. Leng = Arc.ArcLength
25. SPnt = Arc.StartPoint
26. EPnt = Arc.EndPoint
27. CPnt = Arc.Center
29. '选择标注点
30. Dim PntforDim As Variant
31. PntforDim = ThisDrawing.Utility.GetPoint(, "选择标注点位置：")
33. '对圆弧进行角度标注
34. Dim DimAng As AcadDim3PointAngular
35. Set DimAng = ThisDrawing.ModelSpace.AddDim3PointAngular(CPnt, SPnt, EPnt, PntforDim)
37. '获取角度标注的精度控制(小数点位)
38. Dim FormatDot As Integer
39. Dim FormatTxt As String
40. FormatDot = DimAng.TextPrecision
41. '转换为精度控制格式
42. FormatTxt = "0."
43. Dim I As Integer
44. For I = 0 To FormatDot
45. If I > 0 Then
46. FormatTxt = FormatTxt & "0"
47. End If
48. Next
49. '更改角度标注的文字内容
50. DimAng.TextOverride = Format(Leng, FormatTxt)
52. End Sub

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 > 0 Then FormatTxt = FormatTxt & "0" End If Next '更改角度标注的文字内容 DimAng.TextOverride = Format(Leng, FormatTxt) End Sub

已知弧长和半径求圆弧角公式
ang = arcLen/Radius
程序如下:

2. Sub llss()
3.   Dim objArc As AcadArc
4.   Dim pp(2) As Double
5.   Dim Ang, startAng, endAng
6.   Dim arcLen, Dia, Delta
7.   arcLen = 2050: Dia = 1500: Delta = 16
8.   Ang = (arcLen / (Dia / 2))
9.   startAng = (Atn(1) * 4) * 1.5 - Ang / 2
10.   endAng = startAng + Ang
11.   '
12.   With ThisDrawing.ModelSpace
13.     Set objArc = .AddArc(pp, Dia / 2, startAng, endAng)
14.     With objArc
15.       Debug.Print .ArcLength
16.     End With
17.   End With
18. End Sub

Sub llss()   Dim objArc As AcadArc   Dim pp(2) As Double   Dim Ang, startAng, endAng   Dim arcLen, Dia, Delta   arcLen = 2050: Dia = 1500: Delta = 16   Ang = (arcLen / (Dia / 2))   startAng = (Atn(1) * 4) * 1.5 - Ang / 2   endAng = startAng + Ang   '   With ThisDrawing.ModelSpace     Set objArc = .AddArc(pp, Dia / 2, startAng, endAng)     With objArc       Debug.Print .ArcLength     End With   End With End Sub

有时间,在此基础上再研究一下,在文字上方画弧的方法,而不是用arcLen=2050的方法.