如題：

圖示：

源碼：

Private Sub huatu()
Dim p1 As Variant
Dim p2 As Variant
On Error GoTo 10000
        p1 = ThisDrawing.Utility.GetPoint(, "指定第一點:")
        p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "指定第二點:")
cd = GetDistance(p1, p2)
ce = GetPointhengkuandu(p1, p2)
ThisDrawing.Utility.GetReal ("距離=" & cd & Chr(13) & "X軸增量=" & ce )
Exit Sub
10000: 'MsgBox Error()
End Sub
'計算兩點之間距離
Public Function GetDistance(ptSt As Variant, ptEn As Variant) As Double
    Dim x As Double
    Dim y As Double
    Dim z As Double
   
    x = ptSt(0) - ptEn(0)
    y = ptSt(1) - ptEn(1)
    z = ptSt(2) - ptEn(2)
   
    GetDistance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
End Function
Public Function GetPointhengkuandu(pts1 As Variant, pts2 As Variant) As Double
GetPointhengkuandu = pts2(0) - pts1(0)
End Function