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