spano 发表于 2018-2-28 21:59:19

第(1)个程序 标准坐标 （测绘）

以下是我写的第一个获取点坐标的程序，有个问题是关于小数位保留的，需要保留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


zzyong00 发表于 2018-2-28 23:06:03

Set Text_X = Application.ActiveDocument.ModelSpace.AddText("X=" & Format(X,"0.000"), Position_X, 1.25)

mikewolf2k 发表于 2018-3-1 11:09:39

保留三位小数也可以先乘以1000，取整，除以1000

spano 发表于 2018-3-1 11:38:49

zzyong00 发表于 2018-2-28 23:06
Set Text_X = Application.ActiveDocument.ModelSpace.AddText("X=" & Format(X,"0.000"), Position_X, 1. ...

可行，非常棒！谢谢指点！
页: [1]
查看完整版本: 第(1)个程序 标准坐标 （测绘）