mycad 发表于 2010-5-11 08:50:00

[求助]急！！关于获取pline线偏移后的坐标问题

<p>'我想获取pline线偏移后的实体（pline）坐标；下面的代码怎么无法实现呢？</p><p>'请高手赐教，谢谢！！！！！！！</p><p>&nbsp; Sub LinetoBOX2()<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim returnObj As AcadObject<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim sset As AcadSelectionSet<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim COOR As Variant<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim CoorL As Variant<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim CoorR As Variant<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim xtype1 As Variant<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim xdata1 As Variant<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim objPl As AcadPolyline<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim objPlL As AcadPolyline<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim objPlR As AcadPolyline<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim obj As AcadObject<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim basepnt As Variant</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim offsetObjL As Variant<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim offsetObjR As Variant<br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set sset = ThisDrawing.SelectionSets.Item("this")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sset.Delete<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set sset = ThisDrawing.SelectionSets.Add("this")<br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; sset.SelectOnScreen<br/>&nbsp;&nbsp;&nbsp;&nbsp; If sset.Count = 0 Then Exit Sub<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim s As String<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim S2 As String<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim offsetval As Double<br/>&nbsp;&nbsp;&nbsp; For Each obj In sset<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox obj.ObjectName<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If obj.ObjectName = "AcDbPolyline" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set objPl = obj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'If obj.ConstantWidth &gt; 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;' offsetval = obj.ConstantWidth<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '向左偏移<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; offsetObjL(0) = objPl.Offset(1.0)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set objPlL = offsetObjL(0)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; CoorL = objPlL.Coordinates<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To UBound(CoorL) 'Step 3<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; s = s + Format(CoorL(i), "0.000") + "," '+ Format(CoorL(i + 1), "0.000") + Format(CoorL(i + 2), "0.000") + vbCrLf<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next i<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '向右偏移<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; offsetObjR(0) = objPl.Offset(-1.0)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set objPlR = offsetObjR(0)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; CoorR = objPlR.Coordinates<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To UBound(CoorR) 'Step 3<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; S2 = S2 + Format(CoorR(i), "0.000") + "," '+ Format(CoorR(i + 1), "0.000") + Format(CoorR(i + 2), "0.000") + vbCrLf<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next i</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox s + vbCrLf + "*************************************" + vbCrLf + S2<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'ThisDrawing.SendCommand "huan" &amp; vbCr<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'ThisDrawing.SendCommand "(command " &amp; """huan""" &amp; " "")"</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sset.Clear<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "数据处理完毕！", vbInformation<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sset.Delete<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit Sub<br/>line:<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox Err.Description, vbCritical<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp; End Sub</p>

mycad 发表于 2010-5-11 13:48:00

<p>&nbsp;&nbsp;已解决，谢谢各位 </p><p>把&nbsp;&nbsp;&nbsp; Dim objPl As AcadPolyline<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim objPlL As AcadPolyline<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim objPlR As AcadPolyline<br/>改为</p><p>Dim objPl As AcadLWPolyline</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim objPlL As AcadLWPolyline<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim objPlR As AcadLWPolyline</p><p>即可<br/></p>
页: [1]
查看完整版本: [求助]急！！关于获取pline线偏移后的坐标问题