TheSwamp
Code Red => VB(A) => Topic started by: cadpro on July 13, 2008, 03:23:25 AM
-
Hi,
How can I find out in vba if xref is inserted in model space or paper space?
Thanks
-
Guess you need check the 'OwnerID' of xref,
then get the owner with the help of
'ObjectIdToObject' function
~'J'~
-
Cadpro
Couldn't you tell by just looking?
Perhaps in the xref manager?
Is there something specific that you are trying to do?
Cadr
-
How is the xref being selected?
-
I'm trying to change the color of all xrefs in a drawing, except for the xrefs inserted into paper space.
Thanks
-
Not sure about it will works correct
Just was written blindly without editor
so you need to test it extensively
Sub ChXrefColor()
Dim oEnt As AcadEntity
Dim oXRef As AcadExternalReference
Dim i As Integer
Dim col As Integer
col = CInt(InputBox(vbCrLf & "Enter color number <1-255> : ", "XRef Color", 121))
For Each oEnt In ThisDrawing.ModelSpace
If TypeOf oEnt Is AcadExternalReference Then
Set oXRef = oEnt
oXRef.color = col
End If
Next
End Sub
~'J'~
-
That's pretty much what I was thinking. If you are dealing with really huge drawings, you could do a filtered selection set to select the modelspace xrefs but for normal sized drawings, there shouldn't be much of a performance knock doing it that way. If you are needing to change the layer colors in that xrefs, you can use the oxref's name and loop through the layers.
-
That didn't work! I doesn't change the xref layer color.
-
Since it's pretty obvious that you are in a big hurry for it, I'll add some more. Just typing it in this window so it'll probably need some tweaking.
Sub ChXrefColor()
Dim oEnt As AcadEntity
Dim oXRef As AcadExternalReference
Dim i As Integer
Dim col As Integer
Dim oLays as acadlayers
dim oLay as acadlayer
dim sLay as string
set olays as thisdrawing.layers
col = CInt(InputBox(vbCrLf & "Enter color number <1-255> : ", "XRef Color", 121))
For Each oEnt In ThisDrawing.ModelSpace
If TypeOf oEnt Is AcadExternalReference Then
Set oXRef = oEnt
for each olay in olays
if left(olay.name, len(oxref.name)) = oxref.name then
olay.color = col
end if
next olay
End If
Next oent
End Sub
-
Actually, that probably needs to be set as truecolor, not color.
-
Thank you sooooooo much! You are great!
Oh wait! I'm sorry to tell you that unfortunately it doesn't change the layer color of nested xrefs. Is there any solution to that?
Thanks
-
Why do you need to? I didn't think the layer colour of xrefs actually did anything.
-
Here's some stuff from a thingy. The code as it is here is used to get paths of xrefs, but shows a method for drilling in looking for nested xrefs. Let me know if you need help putting it together.
Private Sub LoadXrefs()
Dim objSelSets As AcadSelectionSets
Dim objSelSet As AcadSelectionSet
Dim intType(0) As Integer
Dim varData(0) As Variant
Dim strPaths() As String
Dim intCnt As Integer
Dim objXref As AcadExternalReference
Dim objEnt As AcadEntity
Dim objBlk As AcadBlock
Dim objBlks As AcadBlocks
Dim intDuplicate As Integer
Dim objDuplicate As AcadEntity
Dim boolDuplicate As Boolean
Set objBlks = ThisDrawing.Blocks
Set objSelSets = ThisDrawing.SelectionSets
For Each objSelSet In objSelSets
If objSelSet.Name = "GetXrefPaths" Then
objSelSets.Item("GetXrefPaths").Delete
Exit For
End If
Next
Set objSelSet = objSelSets.Add("GetXrefPaths")
intType(0) = 0: varData(0) = "INSERT"
objSelSet.Select acSelectionSetAll, , , intType, varData
For Each objEnt In objSelSet
Set objBlk = objBlks(objEnt.Name)
If objBlk.IsXRef Then
boolDuplicate = False
For intDuplicate = 1 To colXrefs.Count
Set objDuplicate = colXrefs.Item(intDuplicate)
If objDuplicate.Name = objEnt.Name Then
boolDuplicate = True
Exit For
End If
Next intDuplicate
If boolDuplicate = False Then
colXrefs.Add objEnt '.Path
GetNested objBlk
End If
End If
Next objEnt
End Sub
Private Function GetNested(objBlk As AcadBlock) As Integer
Dim objXref As AcadExternalReference
Dim objBlkRef As AcadBlockReference
Dim objEnt As AcadEntity
Dim objNext As AcadBlock
For Each objEnt In objBlk
If TypeOf objEnt Is AcadBlockReference Then
Set objBlkRef = objEnt
Set objNext = ThisDrawing.Blocks(objBlkRef.Name)
If objNext.IsXRef Then
Set objXref = objEnt
colXrefs.Add objXref
GetNested objNext
End If
End If
Next
GetNested = colXrefs.Count
End FunctionHaven't really looked at that code in a good while. I have no idea why GetNested is a function instead of a sub.
Danellis, changing xref layers changes the appearance of the objects on those layers, as long as the color/lt are set to bylayer. The same as any other object on any other layer.
-
What could be colXrefs?
-
In this case colxrefs is a collection declared publicly
-
You wouldn't ever have to add the xrefs to a collection though, just go through looking for nested xrefs, if found change layer properties.