社区 › VB › 高手帮忙写个提取cad里面 线段的各个转点坐标

sky13800 发表于 2009-11-5 00:46:00

高手帮忙写个提取cad里面 线段的各个转点坐标

如图上有一条线有20个转点   
我想得到这20个转点的坐标保存到文本文件怎么写呢?

gdzhou 发表于 2009-11-5 13:56:00

Sub Test()
Dim ent As AcadEntity
Dim obj As Object
Dim pt
ThisDrawing.Utility.GetEntity obj, pt, "Select" & vbCrLf
Set ent = obj
DebugPrn ent
End Sub
Private Function DebugPrn(PL As AcadEntity)
Dim k As Integer, i As Integer
Dim p
Select Case UCase(PL.ObjectName)
    Case "ACDB2DPOLYLINE", "ACDB3DPOLYLINE"
      k = 3
    Case "ACDBPOLYLINE"
      k = 2
End Select
If k0 Then
    p = PL.Coordinates
    For i = 0 To (UBound(p) + 1) / k - 1
      Debug.Print "Vertex " & i + 1, "X=" & Format(p(i * k), "0.000"), "Y=" & Format(p(i * k + 1), "0.000")
    Next i
Else
    Debug.Print "不是多段线！"
End If
End Function
=============运行结果=============================
Vertex 1      X=1181.440    Y=676.518
Vertex 2      X=1353.503    Y=576.104
Vertex 3      X=1396.093    Y=443.353
Vertex 4      X=1373.946    Y=353.151
Vertex 5      X=1321.135    Y=278.266

ljttjl 发表于 2009-11-5 19:34:00

网盘http://ljttjl.ys168.com20090222目录下载多段线坐标提取程序。

sky13800 发表于 2009-11-5 23:37:00

谢谢

查看完整版本: 高手帮忙写个提取cad里面 线段的各个转点坐标