yswoyh 发表于 2009-8-27 13:07:00

老大！帮忙看看，自己没搞定，arc坐标输出，谢谢了

<p>Sub test()<br/>&nbsp;&nbsp;&nbsp;&nbsp; Dim X As Double, y As Double, Z As Double<br/>&nbsp;&nbsp;&nbsp;&nbsp; Dim n As Long<br/>&nbsp;&nbsp;&nbsp;&nbsp; n = ThisDrawing.ModelSpace.Count</p><p>&nbsp;&nbsp;&nbsp;&nbsp; Dim Pt As Variant<br/>&nbsp;&nbsp;&nbsp;&nbsp; Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")<br/>&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SendCommand "_-Boundary" &amp; vbCr &amp; Pt(0) &amp; "," &amp; Pt(1) &amp; vbCr &amp; vbCr</p><p>&nbsp;&nbsp;&nbsp;&nbsp; Dim lwpLineObj As AcadLWPolyline<br/>&nbsp;&nbsp;&nbsp;&nbsp; If ThisDrawing.ModelSpace.Count &gt; n Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set lwpLineObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'MsgBox "面积" &amp; Format(lwpLineObj.Area, "0.000") &amp; "平方米"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'lwpLineObj.Delete<br/>&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "未发现有效的边界"<br/>&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim i As Long, num As Long<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim retCoord As Variant<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; num = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; retCoord = lwpLineObj.Coordinates<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; num = (UBound(retCoord) - LBound(retCoord) + 1) / 2<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To num - 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &nbsp;X = retCoord(2 * i + 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &nbsp;y = retCoord(2 * i)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &nbsp;MsgBox ("X=" &amp; X &amp; "&nbsp; " &amp; "Y=" &amp; y)</p><p>怎么判断是圆弧，并把圆弧的数据读出？？？？？？？？？？？&nbsp; 谢谢了<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next i<br/>End Sub</p>

home 发表于 2009-8-29 16:39:00

&nbsp;&nbsp;&nbsp; Dim sset As AcadSelectionSet<br/>&nbsp;&nbsp;&nbsp; Dim obj As Object<br/>&nbsp;&nbsp;&nbsp; Dim objarc As AcadArc<br/>&nbsp;&nbsp;&nbsp; For Each obj In sset<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If TypeOf obj Is AcadArc Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set objarc = obj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '获得圆弧的数据<br/>&nbsp;&nbsp;&nbsp; Next
页: [1]
查看完整版本: 老大！帮忙看看，自己没搞定，arc坐标输出，谢谢了