明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1666|回复: 3

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

[复制链接]
发表于 2009-11-5 00:46:00 | 显示全部楼层 |阅读模式

如图上有一条线  有20个转点  

我想得到这20个转点的坐标保存到文本文件  怎么写呢?

发表于 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 k <> 0 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

发表于 2009-11-5 19:34:00 | 显示全部楼层

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

 楼主| 发表于 2009-11-5 23:37:00 | 显示全部楼层
谢谢
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-26 00:42 , Processed in 0.157283 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表