|
|
以下是我写的第一个获取点坐标的程序，有个问题是关于小数位保留的，需要保留3位小数
'The first function of getting point coordinate
Sub XY()
Dim Point1, Point2 As Variant
Dim Point1_X, Point2_X, Point3_X As Double
Dim Point1_Y, Point2_Y, Point3_Y As Double
Dim prompt1 As String
Dim UnderLine_Length As Double
prompt1 = vbCrLf & "Select a point:"
Point1 = ThisDrawing.Utility.GetPoint(, "选择需标注点:")
Point1_X = Point1(0)
Point1_Y = Point1(1)
Point2 = ThisDrawing.Utility.GetPoint(, "选择标注位置:")
Point2_X = Point2(0)
Point2_Y = Point2(1)
Point2_X = Round(Point2_X, 2)
Point2_Y = Round(Point2_Y, 2)
If (Point2_X >= Point1_X) Then
UnderLine_Length = 10
Else
UnderLine_Length = -10
End If
Point3_X = Point2_X + UnderLine_Length
Point3_Y = Point2_Y
Dim pline_vertex(0 To 5) As Double
pline_vertex(0) = Point1_X: pline_vertex(1) = Point1_Y:
pline_vertex(2) = Point2_X: pline_vertex(3) = Point2_Y:
pline_vertex(4) = Point3_X: pline_vertex(5) = Point3_Y:
Dim pline As AcadLWPolyline
'绘制标识线段
Set pline = Application.ActiveDocument.ModelSpace.AddLightWeightPolyline(pline_vertex)
'添加坐标标识
Dim X As Double
Dim Y As Double
Dim Text_X, Text_Y As AcadText
Dim Position_X(2) As Double
Dim Position_Y(2) As Double
X = Round(Point1_X, 3) '截取三位小数
Y = Round(Point1_Y, 3)
If (Point2_X >= Point1_X) Then
Position_X(0) = Point2_X
Position_X(1) = Point2_Y + 0.2
Position_X(2) = 0
Position_Y(0) = Point2_X
Position_Y(1) = Point2_Y - 1.8
Position_Y(2) = 0
Else
Position_X(0) = Point3_X
Position_X(1) = Point3_Y + 0.2
Position_X(2) = 0
Position_Y(0) = Point3_X
Position_Y(1) = Point3_Y - 1.8
Position_Y(2) = 0
End If
Set Text_X = Application.ActiveDocument.ModelSpace.AddText("X=" & CStr(X), Position_X, 1.25)
Set Text_X = Application.ActiveDocument.ModelSpace.AddText("Y=" & CStr(Y), Position_Y, 1.25)
Text_X.Update
End Sub
|
|
置顶卡
