|
|
我用VBA编制的粗糙度程序,数值不能随粗糙度符号方向改变而改变，请大家帮忙看看。谢谢了！！
Sub rough()
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim p3(0 To 2) As Double
Dim p0 As Variant
Dim a, a1, a2 As Double
Dim h1 As Double
Dim text As String
On Error Resume Next
p0 = ThisDrawing.Utility.GetPoint(, "请输入粗糙度符号插入点:")
a = ThisDrawing.Utility.GetAngle(, "请输入粗糙度符号旋转角:")
text = ThisDrawing.Utility.GetString(1, vbCrLf & "请输入粗糙度符号Ra值:")
h = ThisDrawing.Utility.GetReal("请输入粗糙度符号文本字符高度:")
h1 = 1.4 * h / Cos(30 * 3.14159 / 180)
p1(0) = p0(0) + 2 * h1 * Cos(60 * 3.14159 / 180 + a)
p1(1) = p0(1) + 2 * h1 * Sin(60 * 3.14159 / 180 + a)
p1(2) = 0
p2(0) = p0(0) - h1 * Cos(60 * 3.14159 / 180 - a)
p2(1) = p0(1) + h1 * Sin(60 * 3.14159 / 180 - a)
p2(2) = 0
p3(0) = p0(0) + h1 * Cos(60 * 3.14159 / 180 + a)
p3(1) = p0(1) + h1 * Sin(60 * 3.14159 / 180 + a)
p3(2) = 0
Dim line1 As AcadLine
Dim line2 As AcadLine
Dim line3 As AcadLine
Set line1 = ThisDrawing.ModelSpace.AddLine(p0, p2)
Set line2 = ThisDrawing.ModelSpace.AddLine(p2, p3)
Set line3 = ThisDrawing.ModelSpace.AddLine(p0, p1)
ThisDrawing.Application.ZoomExtents
Dim tobject As AcadText
tobject = ThisDrawing.ModelSpace.AddText(text, p2, h)
ThisDrawing.Application.ZoomExtents
a2 = 180 * a / 3.14159
If a2 > 90 And a2 270 Then
a1 = a - 2 * 3.14159
ElseIf a2 = -90 Then
a1 = 3.14159 / 2
ElseIf a2 < 90 Then
a1 = a
End If
tobject.Alignment = acAlignmentLeft
tobject.Rotation = a1
tobject.Update
End Sub
|
|
置顶卡
