The problem is this huge hole in the object model that exposes the path of
an XRef *only* via AcadExternalReference instead of thru the Block object.
Give this a shot:
Option Explicit
Public Sub Test()
Dim XRefs As New Collection
Set XRefs = GetXRefs
Dim XRef As AcadExternalReference
Dim ynInserted As Boolean
Dim i As Integer
For i = 1 To XRefs.Count
Set XRef = XRefs(i)
ynInserted = IsInserted(XRef)
Debug.Print _
"XRef name: " & XRef.Name & _
vbCrLf & "XRef path: " & XRef.Path
If ynInserted Then
Debug.Print _
"Inserted at: " & _
CStr(XRef.InsertionPoint(0)) & "," & _
CStr(XRef.InsertionPoint(1)) & "," & _
CStr(XRef.InsertionPoint(2)) & _
vbCrLf & "Scale factor: " & XRef.XScaleFactor
End If
Next i
End Sub
Private Function IsInserted(Block As AcadExternalReference) As Boolean
Dim BlockOwner As Long
BlockOwner = Block.OwnerID
If BlockOwner = ThisDrawing.ModelSpace.ObjectID Then
IsInserted = True
Exit Function
End If
Dim ThisLayout As AcadLayout
For Each ThisLayout In ThisDrawing.Layouts
If BlockOwner = ThisLayout.ObjectID Then
IsInserted = True
Exit Function
End If
Next ThisLayout
End Function
Private Function GetXRefs() As Collection
Dim ThisBlock As AcadBlock
Dim ThisObject As AcadEntity
Dim AnXRef As AcadExternalReference
Dim Result As New Collection
Dim i As Integer
For Each ThisBlock In ThisDrawing.Blocks
For Each ThisObject In ThisBlock
If TypeOf ThisObject Is AcadExternalReference Then
Set AnXRef = ThisObject
Result.Add AnXRef, CStr(i)
i = i + 1
End If
Next ThisObject
Next ThisBlock
Set GetXRefs = Result
Set Result = Nothing
End Function
--
R. Robert Bell, MCSE
www.AcadX.com
"Graeme Hyslop"
wrote in message
news:[email protected]...
| I''m new to VBA so excuse me for all the bad programming in this routine.
| I'm trying to get it to tell me what xref's and nested xref's are in a
| drawing and give their file path, insertion point and scale.
| I can get this information for the main xref's but I can only seem to get
| the name for the nested xrefs.
| I cant seem to get my head round the difference between a block and a
| blockreference and why I can can only get certain properties for each one.
|
| Thanks
|
| Graeme
|
|
| Option Explicit
|
| Public Sub QDA_list()
| On Error Resume Next
| Dim XrfObj As AcadBlock
| Dim XrfRef As AcadBlockReference
| Dim Xrfnme As String
| Dim XrfInsPt As Variant
| Dim XrfScle As Variant
| Dim XrfPath As String
| Dim i As Integer
| Dim Count As Integer
|
| For i = 0 To Count + 1
| For Each XrfObj In ThisDrawing.Blocks
| Set XrfRef = XrfObj.Item(i)
| If XrfObj.IsXRef Then
| Xrfnme = XrfObj.Name
| 'If Xrfnme = "" Then
| 'MsgBox "there are no xrefs in this drawing"
| XrfInsPt = XrfRef.InsertionPoint
| XrfScle = XrfRef.XScaleFactor
| XrfPath = XrfRef.Path
| MsgBox "The xrefs attached include " & Xrfnme
| MsgBox "The xref path is " & XrfPath
| MsgBox "The xref scale is " & XrfScle
| MsgBox "The xrefs are at " & XrfInsPt(0) & ", " & XrfInsPt(1)
&
| ", " & XrfInsPt(2)
| End If
| Next
| Next i
| End Sub
|
|