多段线提取点坐标-CAD-vba

多段线提取点坐标-CAD-vba Private Sub GetLWPOLYLINECoordinates() Dim ss_dim As AcadSelectionSet, ent As AcadLWPolyline Dim dxf_code() As Integer, dxf_value() As Variant Dim i As Long, j As Long Dim dbCor As Variant, x As Double, y As Double, z As Double Set ss_dim = ThisDrawing.SelectionSets.Add("ssLine1") ReDim dxf_code(0), dxf_value(0) dxf_code(0) = 0: dxf_value(0) = "LWPOLYLINE" ss_dim.Select acSelectionSetAll, , , dxf_code, dxf_value Open "d:\多段线提取点.txt" For Append As #1 For Each ent In ss_dim For j = 0 To UBound(ent.Coordinates) \ 2 x = ent.Coordinates(j * 2) y = ent.Coordinates(j * 2 + 1) Print #1, "X" & x & ",Y" & y Next Next Close #1 ss_dim.Clear ss_dim.Delete End Sub