旋转文字方向怎末无效

xkitty

我用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 - 3.14159
ElseIf 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

雪山飞狐_lzh

你把它做成属性块插入不就玩了

zzg4028061

楼主，Rotation，应该给PI的

clement

错在这句(跟踪发现后面tobject是空的)



tobject = ThisDrawing.ModelSpace.AddText(text, p2, h)


创建是完成了,但是没有赋给变量,而且这是不报错的.


对象赋值别忘了用Set


Set tobject = ThisDrawing.ModelSpace.AddText(text, p2, h)