ObjectCollection to include X-Ref objects

[faugustom]

Hi Everybody,

There is a way to include objects in X-Ref to de included in the ObjectCollection from this code?
(context: it's a vbscrpit used in a Property Set Definition from AutoCAD Architecture to calculate the total lenght of specific walls ([Style]. Actually, it only calculate the walls present in the current drawing).
Thank's

Set app = GetObject (,"AutoCAD.Application")
On Error Resume Next
RESULT = "--"

Set baseApp = app.GetInterfaceObject("AecX.AecArchBaseApplication.8.4")
Set ActiveDoc =baseApp.ActiveDocument
Set ObjectCollection = ActiveDoc.ModelSpace

totLength = 0
s = "[Style]"

For Each Object In ObjectCollection
If Object.StyleName = s Then
totLength = totLength + Object.Length
End IF
Next

RESULT = totLength/100

[Ed__Jobe]

In your iteration of modelspace, you would come across a BlockReference object representing an INSERT. Use the BlockReference.Name property to get the Block object from the block table. If Block.IsXref =true, then get

Block.XrefDatabase. Now iterate the xref db's modelspace for the walls.

[faugustom]

Hello Ed, 

Thank you for the response, but... I don't know how to write code (it's not mine, already used in the company). Besides I understand the guide lines, I have no ideia how to write... it would be to much to ask this? 🙂

[Ed__Jobe]

Sorry, Right now I don't have the time to write the code and test it for scripting. Not sure when I will be free.

[grobnik]

Hi @faugustom 

Could you try to have a look here https://forums.augi.com/showthread.php?172128-AutoCad-VBA-XRef-Handling

[faugustom]

Hi everyone!

Without much success, I tried to edit the code to find the block, identify the Xref, then get objects form its ModelSpace.
Any direction would be very apreciated, thanks

Set app = GetObject (,"AutoCAD.Application")
On Error Resume Next
RESULT = "--"

Set baseApp = app.GetInterfaceObject("AecX.AecArchBaseApplication.8.4")
Set ActiveDoc =baseApp.ActiveDocument
Set ObjectCollection = ActiveDoc.ModelSpace

totLength = 0

'this is the type of walls lenght to be calculated
s = "[Style]"

For Each Object In ObjectCollection

  If Object.StyleName = s Then
    totLength = totLength + Object.Length
  End If

Next

'At this point, all objects in current drawing are being calculated

'Now it must find blocks

Set Blk = AcadBlock

'Search for blocks in ModelSpace blocks
For Each Blk In ObjectCollection.Blocks

  'Ask if the block is a XRef
   If Blk.IsXref = True Then

    'ok, it's a XRef, now scan it's modelspace for Objects
    For Each Object In Blk.XRefDatabase.ModelSpace

      'repeat the same routine
      If Object.StyleName = s Then
        totLength = totLength + Object.Length
      End If

    Next

  End If

Next

RESULT = totLength

[faugustom · Accepted solution]

Solved!

Now, the PSD is calculating the total length based on the style and then on the height of the walls. Fisrt it looks for objects in Blocks (Xref's) and then in other objects of the drawing.

Set app = GetObject (,"AutoCAD.Application")
On Error Resume Next
RESULT = "--"

Set baseApp = app.GetInterfaceObject("AecX.AecArchBaseApplication.8.4")
Set ActiveDoc = baseApp.ActiveDocument
Set ObjectCollection = ActiveDoc.ModelSpace
Set BlocksCollection =  ActiveDoc.Blocks

totLength = 0
s = "[Style]"
h = "[DimsAlturamm]"

For Each Block In BlocksCollection
	IF Block.IsXref = True Then
		Set XrefCollection = Block.XRefDatabase.ModelSpace
		For Each Object In XrefCollection
			If Object.StyleName = s Then
				If CStr((Object.BaseHeight)*100) = h Then
					totLength = totLength + Object.Length
				End IF
			End IF
		Next
	End IF
Next
For Each Object In ObjectCollection
	IF Object.StyleName = s Then
		If CStr((Object.BaseHeight)*100) = h Then
			totLength = totLength + Object.Length
		End IF
	End IF
Next
RESULT = totLength