Select Case TypeName(Object)
Case "IAcadPolyline", "IAcadLWPolyline", "IAcad3DPolyline"
For i = 0 To GetVertexCount(Object) - 1
OutStr = OutStr & vbCrLf & Utility.RealToString(Object.Coordinate(i)(0), acDefaultUnits, 3)
OutStr = OutStr & " " & Utility.RealToString(Object.Coordinate(i)(1), acDefaultUnits, 3)
If TypeName(Object) = "IAcad3DPolyline" Then
OutStr = OutStr & " " & Utility.RealToString(Object.Coordinate(i)(2), acDefaultUnits, 3)
Else
OutStr = OutStr & " " & Utility.RealToString(Object.Elevation, acDefaultUnits, 3)
End If
Next
Case "IAcadPoint"
pt = Object.Coordinates
OutStr = Utility.RealToString(pt(0), acDefaultUnits, 3)
OutStr = OutStr & " " & Utility.RealToString(pt(1), acDefaultUnits, 3)
OutStr = OutStr & " " & Utility.RealToString(pt(2), acDefaultUnits, 3)
Case "IAcadBlockReference2", "IAcadShape"
pt = Object.InsertionPoint
OutStr = Utility.RealToString(pt(0), acDefaultUnits, 3)
OutStr = OutStr & " " & Utility.RealToString(pt(1), acDefaultUnits, 3)
OutStr = OutStr & " " & Utility.RealToString(pt(2), acDefaultUnits, 3)
End Select
MsgBox OutStr
Exit Sub
NOT_ENTITY:
If MsgBox("您未选中图元。按OK重试.", _
vbOKCancel & vbInformation) = vbOK Then
Resume TRYAGAIN
End If
End Sub
Public Function GetVertexCount(Polyline) As Integer
On Error Resume Next
Select Case TypeName(Polyline)
Case "IAcadLWPolyline"
VertList = Polyline.Coordinates
GetVertexCount = (UBound(VertList) + 1) / 2
Case "IAcadPolyline", "IAcad3DPolyline"
VertList = Polyline.Coordinates
GetVertexCount = (UBound(VertList) + 1) / 3
End Select
End Function
Select Case TypeName(Object)
Case "IAcadPolyline", "IAcadLWPolyline", "IAcad3DPolyline"
'Dim n As Long: n = Object.GetVertexCount
For i = 0 To GetVertexCount(Object) - 1
OutStr = OutStr & vbCrLf & Utility.RealToString(Object.Coordinate(i)(0), acDefaultUnits, 3)
OutStr = OutStr & " " & Utility.RealToString(Object.Coordinate(i)(1), acDefaultUnits, 3)
If TypeName(Object) = "IAcad3DPolyline" Then
OutStr = OutStr & vbCrLf & " " & Utility.RealToString(Object.Coordinate(i)(2), acDefaultUnits, 3)
Else
OutStr = OutStr & vbCrLf & " " & Utility.RealToString(Object.Elevation, acDefaultUnits, 3)
End If
Next
Case "IAcadPoint"
pt = Object.Coordinates
OutStr = Utility.RealToString(pt(0), acDefaultUnits, 3)
OutStr = OutStr & " " & Utility.RealToString(pt(1), acDefaultUnits, 3)
OutStr = OutStr & " " & Utility.RealToString(pt(2), acDefaultUnits, 3)
Case "IAcadBlockReference2", "IAcadShape"
pt = Object.InsertionPoint
OutStr = Utility.RealToString(pt(0), acDefaultUnits, 3)
OutStr = OutStr & " " & Utility.RealToString(pt(1), acDefaultUnits, 3)
OutStr = OutStr & " " & Utility.RealToString(pt(2), acDefaultUnits, 3)
End Select
MsgBox OutStr
Exit Sub
NOT_ENTITY:
If MsgBox("您未选中图元。按OK重试.", _
vbOKCancel & vbInformation) = vbOK Then
Resume TRYAGAIN
End If
End Sub
Public Function GetVertexCount(Polyline) As Integer
On Error Resume Next
Select Case TypeName(Polyline)
Case "IAcadLWPolyline"
VertList = Polyline.Coordinates
GetVertexCount = (UBound(VertList) + 1) / 2
Case "IAcadPolyline", "IAcad3DPolyline"
VertList = Polyline.Coordinates
GetVertexCount = (UBound(VertList) + 1) / 3
End Select
End Function
[Quote=引用 22 楼 wangping_li 的回复:]
引用 20 楼 xu_2007 的回复:
Dim Object As Object
Dim PickedPoint As Variant
Dim TransMatrix As Variant
Dim ContextData As Variant