Select in an xref

I need to find the what object in an xref. Getsubent won't work for me. I was trying to find a way to do a 'Select' on the xref database, no luck. I can iterate through the entire database, but it gets large quick, so its slow. Any ideas?

Thanks

John Holmes

 

Here is the guts of a GetSubEntity method that works for me. Please
excuse the word wrap. There are long program lines.

Function ChooseItem() As String
Dim PickedItem As AcadObject
Dim OtherItem As AcadObject
Dim MamaItem As AcadObject
Dim pickedpoint As Variant
Dim transmatrix As Variant
Dim contextdata As Variant
Dim LineQty As Integer
Dim strStat As String
Dim stat As Integer
Dim Title As String
Dim pt As ACAD_POINT
Const strForm = "#,##0.000"
TryAgain:
On Error GoTo NonEnt
LineQty = 0
ThisDrawing.Utility.Prompt vbCr & "<< The ItemStat macro is
running. You must pick an item to escape. >>"
ThisDrawing.Utility.GetSubEntity PickedItem, pickedpoint,
transmatrix, contextdata
If Not (IsEmpty(contextdata)) Then
Set OtherItem = ThisDrawing.ObjectIdToObject(contextdata(0))
If UBound(contextdata) > 0 Then
Set MamaItem =
ThisDrawing.ObjectIdToObject(contextdata(UBound(contextdata)))
End If
Title = PickedItem.ObjectName & " part of " &
OtherItem.ObjectName
strStat = OtherItem.Layer & " = Insertion Layer"
strStat = strStat & vbCr & vbCr & PickedItem.Layer & " =
Layer in block definition"
Else
Title = PickedItem.ObjectName
strStat = PickedItem.Layer & " = Layer"
End If
ActLayNam = PickedItem.Layer
On Error Resume Next ' resume in case is actually layer 0
If ActLayNam = "0" Then ActLayNam = OtherItem.Layer ' for block
parts defined on 0
strStat = strStat & vbCr & vbCr & "Color = " &
IIf(PickedItem.color = 256, "BYLAYER , layer color is " &
ThisDrawing.Layers(PickedItem.Layer).color, PickedItem.color)
strStat = strStat & vbCr & vbCr & "Linetype = " &
IIf(PickedItem.Linetype = "BYLAYER", "BYLAYER , layer Linetype is " &
ThisDrawing.Layers(PickedItem.Layer).Linetype, PickedItem.Linetype)
strStat = strStat & vbCr & vbCr & "Line type scale = " &
PickedItem.LinetypeScale
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Length = " &
Format(PickedItem.Length, strForm) & " Units" & " = " &
Format((PickedItem.Length / 12), strForm) & " L/12"
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Area = " &
Format(PickedItem.Area, strForm) & " Units^2" & " = " &
Format((PickedItem.Area) / 144, strForm) & " A/144"
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Circumference = " &
Format(PickedItem.Circumference, strForm) & " Units" & " = " &
Format((PickedItem.Circumference / 12), strForm) & " L/12"
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Arclength = " &
Format(PickedItem.ArcLength, strForm) & " Units" & " = " &
Format((PickedItem.ArcLength / 12), strForm) & " L/12"
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Diameter = " &
Format(PickedItem.Diameter, strForm) & " Units" & " = " &
Format((PickedItem.diamter / 12), strForm) & " L/12"
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Radius = " &
Format(PickedItem.Radius, strForm) & " Units" & " = " &
Format((PickedItem.Radius / 12), strForm) & " L/12"
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Start angle = " &
Format((PickedItem.StartAngle * 180 / pi), strForm)
On Error Resume Next
strStat = strStat & vbCr & vbCr & "End angle = " &
Format((PickedItem.EndAngle * 180 / pi), strForm)
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Total angle = " &
Format((PickedItem.TotalAngle * 180 / pi), strForm)
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Angle from X = " &
Format((PickedItem.Angle * 180 / pi), strForm) & " , " & Format(((2 *
pi - PickedItem.Angle) * 180 / pi), strForm)
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Thickness = " &
PickedItem.Thickness & " Units" & " = " &
Format((PickedItem.Thickness / 12), strForm) & " L/12"
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Elevation = " &
PickedItem.Elevation
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Pline closure = " &
PickedItem.Closed
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Stylename = " &
PickedItem.StyleName
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Block Name = " & OtherItem.Name
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Scalefactor = " &
PickedItem.ScaleFactor
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Block Rotation = " &
Format((OtherItem.Rotation * 180 / pi), strForm)
On Error Resume Next
strStat = strStat & vbCr & vbCr & "Path = " & OtherItem.Path
On Error Resume Next
strStat = strStat & vbCr & vbCr & "MamaPath = " & MamaItem.Path
Me.Caption = Title
LineQty = VbCrQty(strStat)
Me.Height = Max(20 + 10.5 * LineQty, 130)
ChooseItem = strStat
On Error GoTo 0
Exit Function
NonEnt:
'stat = MsgBox(Err.Number, vbCritical)
Resume TryAgain
End Function