[原创][分享]创建出同dli命令创建的一样的标注
本帖最后由 作者 于 2010-5-22 16:37:00 编辑Sub AddDimRotated()
Dim dimObj As AcadDimRotated
Dim point1 As Variant
Dim point2 As Variant
Dim location As Variant
Dim rotAngle As Double
Dim rotAngleNunmer As Integer
rotAngleNunmer = 1
With ThisDrawing.Utility
point1 = (.GetPoint(, "请指定标注起始点(按Esc或Enter或左健退出):"))
If IsEmpty(point1) Then Exit Sub
End With
With ThisDrawing.Utility
point2 = (.GetPoint(, "请指定标注结束点(按Esc或Enter或左健退出):"))
If IsEmpty(point2) Then Exit Sub
End With
With ThisDrawing.Utility
location = (.GetPoint(, "请指定标注基准点(按Esc或Enter或左健退出):"))
If IsEmpty(location) Then Exit Sub
End With
On Error Resume Next
rotAngleNunmer = ThisDrawing.Utility.GetInteger(vbCrLf & "输入标注位置 [上(1)/下(2)/左(3)/右(4)]: <" & rotAngleNunmer & ">:")
Select Case rotAngleNunmer
Case 1, 2
rotAngle = 0
Case 3, 4
rotAngle = 90
End Select
rotAngle = rotAngle * 3.141592 / 180# ' covert to Radians
Set dimObj = ThisDrawing.ModelSpace.AddDimRotated(point1, point2, location, rotAngle)
End Sub
页:
[1]