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

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

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

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

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

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

<p>网盘<a href="http://ljttjl.ys168.com">http://ljttjl.ys168.com</a>&nbsp; 20090222目录下载多段线坐标提取程序。</p>

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

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