I had fun with this one. My solution was to dump the problem off to AutoLisp
since ActiveX & VBA didn't have the answer.
To get VBA to talk to AutoLisp, I used the USERS1 & USERI1 setting
variables, which let you dump any string (USERS1) or integer (USERI1) data
you need into them. I used AcadDocument.SetVariable to set USERS1 to the
xref name.
Then I used the AcadDocument.SendCommand to call the Lisp routine, which
takes the xref name, gets the block object, and gets the DFX code 70 value
from the xref block. This has several properties as bit flags, of which the
fourth bit (=8) is 1 if it's an overlay, or 0 if it's not. The routine dumps
the code 70 integer value into the USERI1 AutoCAD setting variable & puts
"TRUE" into USERS1 if everything went OK.
Back on the VBA side, the macro grabs the USERS1 setting & checks if it's
now set to "TRUE". If so, then it grabs the USERI1 setting and tests bit
four by doing the bitwise And with 8. It returns True if it's an overlay or
False if not.
The catch is that you have to load the Lisp routine and the VBA routine &
then hope they stay in synch.
ObjectArx has an isFromOverlayReference() method, that would be a smoother
approach, but I'm only getting started in that CAD programming. Too bad the
ActiveX interface isn't so complete.
Here's the code:
<<<<<<<<<<<<<<< VBA CODE >>>>>>>>>>>>>>>>>>>>>>>
Function IsOverlay(XrefName As String, dwg As AcadDocument) As Boolean
Dim blok As AcadBlock
Dim str As String
Dim XrefCode As Long
' *** Default to False
IsOverlay = False
'Set blok = dwg.Blocks(XrefName)
' *** See the XrefName is in the Blocks collection
For Each blok In dwg.Blocks
If StrComp(blok.Name, XrefName, vbTextCompare) = 0 Then
' *** Now see if it's an xref
If blok.IsXRef Then
' *** Now that we have a bonafide xref, pass the name to the
USERS1 AutoCAD user setting
dwg.SetVariable "USERS1", blok.Name
' *** Let the lisp support function do the work
dwg.SendCommand "(getXrefInfo)" & vbCr
' *** Now retrieve the TRUE/FALSE result from USERS1 & if
TRUE, then test the int that was placed in USERI1
str = dwg.GetVariable("USERS1")
If str = "TRUE" Then
XrefCode = dwg.GetVariable("USERI1")
' *** The fourth bit is 1 if it's an overlay (and with 8
to compare)
If XrefCode And 8 Then
IsOverlay = True
End If
End If
End If
End If
Next blok
Set blok = Nothing
End Function
' *** Test function
Sub testOverlay()
Dim ss As AcadSelectionSet
Dim dwg As AcadDocument
Dim blok As AcadBlock
Dim bref As AcadBlockReference
Set dwg = ThisDrawing
Set ss = dwg.ActiveSelectionSet
If SelectObjects(ss) Then
If ss.Item(0).ObjectName = "AcDbBlockReference" Then
Set bref = ss.Item(0)
Set blok = dwg.Blocks(bref.Name)
If blok.IsXRef Then
If IsOverlay(blok.Name, dwg) Then
MsgBox "It's an overlay"
Else
MsgBox "Not an overlay"
End If
End If
End If
End If
Set blok = Nothing
Set bref = Nothing
Set dwg = Nothing
Set ss = Nothing
End Sub
<<<<<<<<<<<<<<< AutoLisp CODE >>>>>>>>>>>>>>>>>>>>>>>
; *** Return xref overlay value when given an object handle
(defun getXrefInfo ( / xrefName xref )
(setq xrefName (getvar "USERS1"))
; *** If there is something in the USERI1 variable (integers)
(if (> (strlen xrefName) 0)
(progn
(setq xref (tblobjname "BLOCK" xrefName))
; *** If the xref was found, return the xref info from group 70 via
USERI1 & put TRUE in USERS1
(if xref
(progn
(print (cdr (assoc 70 (entget xref))))
;(print (assoc 70 (entget xref)))
(setvar "USERI1" (cdr (assoc 70 (entget xref))))
(setvar "USERS1" "TRUE")
(print (getvar "USERI1"))
(print (getvar "USERS1"))
)
; *** Else put FALSE in USERS1
(progn
(setvar "USERS1" "FALSE")
)
)
)
; *** Else return FALSE by writing to the USERS1 variable
(progn
(setvar "USERS1" "FALSE")
)
)
)
"Bdaviswh" wrote in message
news:f112360.-1@WebX.maYIadrTaRb...
Does anyone know how to tell if an xref that is already referenced is an
attachment or an overlay in VBA?
