乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 56|回复: 3

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

[复制链接]

1

主题

2

帖子

1

银币

初来乍到

Rank: 1

铜币
6
发表于 2009-11-5 00:46:00 | 显示全部楼层 |阅读模式
如图上有一条线  有20个转点   
我想得到这20个转点的坐标保存到文本文件  怎么写呢?
回复

使用道具 举报

0

主题

46

帖子

4

银币

初来乍到

Rank: 1

铜币
46
发表于 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
回复

使用道具 举报

27

主题

309

帖子

10

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
417
发表于 2009-11-5 19:34:00 | 显示全部楼层
网盘http://ljttjl.ys168.com  20090222目录下载多段线坐标提取程序。
回复

使用道具 举报

1

主题

2

帖子

1

银币

初来乍到

Rank: 1

铜币
6
发表于 2009-11-5 23:37:00 | 显示全部楼层
谢谢
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-1 19:45 , Processed in 1.502509 second(s), 60 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表