Question

cad 中 点的坐标提取？（我看到你写的三维多段线坐标提取的源代码了）

我试了的 可是没成功......

Answer 1

就是以下代码即可，没成功是出错了还是没有结果？

Private Sub GetLWPOLYLINECoordinates()
Dim ss_dim As AcadSelectionSet, ent As AcadEntity
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
On Error GoTo ErrExit
Set ss_dim = ThisDrawing.SelectionSets.Add("sPolyLines")
ReDim dxf_code(3), dxf_value(3)
dxf_code(0) = -4: dxf_value(0) = "<OR"
dxf_code(1) = 0: dxf_value(1) = "LWPOLYLINE" '这里表示2D多义线
dxf_code(2) = 0: dxf_value(2) = "POLYLINE" '这里表示3D多义线
dxf_code(3) = -4: dxf_value(3) = "OR>"

ss_dim.Select acSelectionSetAll, , , dxf_code, dxf_value

Open "d:\aaaaa.txt" For Append As #1
'"AcDb3dPolyline","AcDbPolyline"
For Each ent In ss_dim
Select Case ent.ObjectName
Case "AcDb3dPolyline"'这里处理3D多义线坐标
Dim ent3D As Acad3DPolyline
Set ent3D = ent
For j = 0 To UBound(ent3D.Coordinates) \ 3
x = ent3D.Coordinates(j * 3)
y = ent3D.Coordinates(j * 3 + 1)
z = ent3D.Coordinates(j * 3 + 2)
Print #1, "X" & x & ",Y" & y & ",Z" & z
Next
Case "AcDbPolyline"'这里处理2D多义线坐标
Dim ent2D As AcadLWPolyline
Set ent2D = ent
For j = 0 To UBound(ent2D.Coordinates) \ 2
x = ent2D.Coordinates(j * 2)
y = ent2D.Coordinates(j * 2 + 1)
Print #1, "X" & x & ",Y" & y & ",Z" & ent2D.Elevation
Next
End Select
Next
ErrExit:
ss_dim.Clear
ss_dim.Delete
Close #1
End Sub

Answer 2

标注里面可以直接标注点坐标