通过CADVBA生成坐标表(原创)

Inserpoint(1) = point(1) - 0.75
Inserpoint(2) = 0
inserpoint_X(0) = point(0) + 2.5
inserpoint_X(1) = point(1) - 0.75
PL_xy(1) = point(1)
PL_xy(2) = point(0) + 7
PL_xy(3) = point(1)
Set PL_biao = ThisDrawing.ModelSpace.AddLightWeightPolyline(PL_xy)
Set TEXT_X = ThisDrawing.ModelSpace.AddText(X, inserpoint_X, 0.36)
Set TEXT_Y = ThisDrawing.ModelSpace.AddText(Y, inserpoint_Y, 0.36)
Set PL_biao = ThisDrawing.ModelSpace.AddLightWeightPolyline(PL_xy)
PL_xy(0) = point(0) + 1
PL_xy(2) = point(0) + 1
If TypeOf ENT Is AcadLWPolyline Then
Set PL_ent = ENT
Dim pointXY() As Double
Dim point() As Double
point = ThisDrawing.Utility.GetPoint(, "请拾取表格放置点：")
inserpoint_X(0) = point(0) + 2.5
inserpoint_X(1) = point(1) - 0.25
inserpoint_X(2) = 0
inserpoint_Y(0) = point(0) + 5.5
PL_xy(0) = point(0) + 7
PL_xy(2) = point(0) + 7
Set PL_biao = ThisDrawing.ModelSpace.AddLightWeightPolyline(PL_xy)
PL_xy(0) = point(0)
Public Sub xy()
Dim ENT As AcadEntity
Dim pickpoint As Variant
Dim PL_ent As AcadLWPolyline
ThisDrawing.Utility.GetEntity ENT, pickpoint, "请选择要生成坐标表的线："
TEXT_Y.Alignment = acAlignmentMiddle
TEXT_Y.TextAlignmentPoint = inserpoint_Y
TEXT_Y.Alignment = acAlignmentLeft
pointXY = PL_ent.Coordinates
Dim i As Integer, n As Integer
n = (UBound(pointXY) - 1) / 2
Dim PL_biao As AcadLWPolyline
Set PL_biao = ThisDrawing.ModelSpace.AddLightWeightPolyline(PL_xy)
PL_xy(0) = point(0) + 4
PL_xy(2) = point(0) + 4
Set PL_biao = ThisDrawing.ModelSpace.AddLightWeightPolyቤተ መጻሕፍቲ ባይዱine(PL_xy)
Next i
Dim Inserpoint(0 To 2) As Double, inserpoint_X(0 To 2) As Double, inserpoint_Y(0 To 2) As Double
Dim TEXT_id As AcadText, TEXT_X As AcadText, TEXT_Y As AcadText
inserpoint_X(2) = 0
inserpoint_Y(0) = point(0) + 5.5
inserpoint_Y(1) = point(1) - 0.75
inserpoint_Y(2) = 0
TEXT_X.Alignment = acAlignmentMiddle
TEXT_X.TextAlignmentPoint = inserpoint_X
TEXT_X.Alignment = acAlignmentLeft
TEXT_X.Alignment = acAlignmentMiddle
TEXT_X.TextAlignmentPoint = inserpoint_X
TEXT_X.Alignment = acAlignmentLeft
TEXT_Y.Alignment = acAlignmentMiddle
TEXT_Y.TextAlignmentPoint = inserpoint_Y
TEXT_Y.Alignment = acAlignmentLeft
Inserpoint(0) = point(0) + 0.5
TEXT_id.Alignment = acAlignmentMiddle
TEXT_id.TextAlignmentPoint = Inserpoint
TEXT_id.Alignment = acAlignmentLeft
X = Format(Round(pointXY(2 * i + 1), 3), "###.000")
Set TEXT_id = ThisDrawing.ModelSpace.AddText(QZ & (i + 1), Inserpoint, 0.36)
Dim X As String, Y As String
Inserpoint(0) = point(0) + 0.5
Inserpoint(1) = point(1) - 0.25
Inserpoint(2) = 0
TEXT_id.Alignment = acAlignmentMiddle
TEXT_id.TextAlignmentPoint = Inserpoint
TEXT_id.Alignment = acAlignmentLeft
Inserpoint(1) = Inserpoint(1) - 0.5
inserpoint_X(1) = inserpoint_X(1) - 0.5
inserpoint_Y(1) = inserpoint_Y(1) - 0.5
inserpoint_Y(1) = point(1) - 0.25
inserpoint_Y(2) = 0
Set TEXT_id = ThisDrawing.ModelSpace.AddText("序号", Inserpoint, 0.36)
Dim PL_xy(0 To 3) As Double
PL_xy(0) = point(0)
PL_xy(1) = point(1)
PL_xy(2) = point(0)
PL_xy(3) = point(1) - 0.5 * (n + 2)
For i = 0 To n + 1
PL_xy(1) = point(1) - 0.5 * (i + 1)
PL_xy(3) = point(1) - 0.5 * (i + 1)
Set PL_biao = ThisDrawing.ModelSpace.AddLightWeightPolyline(PL_xy)
Next i
Else
MsgBox "所选的对象不是多段线，请重新选择！"
Exit Sub
End If
End Sub
Dim QZ As String
QZ = InputBox(" 请输入界址点前缀：")
For i = 0 To n
Y = Format(Round(pointXY(2 * i), 3), "###.000")
Set TEXT_X = ThisDrawing.ModelSpace.AddText("X 坐标", inserpoint_X, 0.36)
Set TEXT_Y = ThisDrawing.ModelSpace.AddText("Y 坐标", inserpoint_Y, 0.36)