求弧长标注
<p>已知直径和弧长画弧，并标注弧长。谢谢。</p> 本帖最后由 作者 于 2009-8-31 10:27:31 编辑见http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=666标注圆弧长度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
程序如下: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的方法.
页:
[1]