Insertion point for dynamic blocks not matching those shown in properties

[Thomas.Long]

So I wrote a program that updates the UCS, grabs a bunch of dimensions, then writes out a bunch of properties for selected blocks. It then compares the coordinates on the blocks to the dimensions to determine the geometry of the entire assembly. Up until now I haven't had any issues. Most of the time it would update the UCS and write out the information to an excel file exactly as expected.

Recently I had an issue where it got the geometry completely wrong. On further inspection it was because the dimensions were outputting the correct numbers but the blocks were still using the world UCS. Anyone have any idea why the blocks weren't updating their coordinates when I updated the UCS? To be clear I did double check, and the UCS had properly updated to the new point. It looks like the blocks are showing in their properties the new updated ucs system coordinates but when I do a get on the insertion point in VBA it's giving me the coordinates for the world ucs only there.

Function WriteBase(xlApp, xlBook, BeamSheet, StringerSheet)

On Error GoTo ErrorHandler
    
'Variables for arranging objects by x coordinates
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    Dim oArrangedEnt As AcadEntity
    Dim oEnt As AcadEntity
    
    Dim BeamArray() As AcadBlockReference
    Dim oHolder As AcadBlockReference
    Dim StringerArray() As AcadBlockReference
    
    Dim oSset As AcadSelectionSet
    
    Dim oLength As Double
    Dim LastInsertion As Double
    
    Dim i As Integer
    Dim irow As Integer
    Dim j As Integer
    Dim rowCounter As Integer
    
    Dim oSize As String

    Dim EndPoint As Variant
    Dim Props As Variant
    Dim StartPoint As Variant
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\


'Intializing Arrays
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    ReDim BeamArray(0)
    ReDim StringerArray(0)
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\


'Select Information
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    Set oSset = ThisDrawing.PickfirstSelectionSet
    oSset.Clear
    
    Dim fcode(0) As Integer
    Dim fdata(0) As Variant
    
    fcode(0) = 0
    fdata(0) = "INSERT"

    oSset.SelectOnScreen fcode, fdata
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\


'Separate beams and stringers into different arrays
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    For Each oEnt In oSset
        If oEnt.IsDynamicBlock Then
            Props = oEnt.GetDynamicBlockProperties
            
            For i = LBound(Props) To UBound(Props)
                If Props(i).PropertyName = "Visibility1" Then oSize = Props(i).Value
            Next
        
            StartPoint = oSize & "StartPosition"
            EndPoint = oSize & "EndPosition"
            oEnt.GetBoundingBox StartPoint, EndPoint
            
            
            If StartPoint(0) - EndPoint(0) > StartPoint(1) - EndPoint(1) Then
                Set BeamArray(UBound(BeamArray)) = oEnt
                ReDim Preserve BeamArray(UBound(BeamArray) + 1)
            Else
                Set StringerArray(UBound(StringerArray)) = oEnt
                ReDim Preserve StringerArray(UBound(StringerArray) + 1)
            End If
        End If
    Next
    
    ReDim Preserve StringerArray(UBound(StringerArray) - 1)
    ReDim Preserve BeamArray(UBound(BeamArray) - 1)
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\



'Sorting beam and stringer arrays by x and y dimensions respectively
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    For i = LBound(BeamArray) To UBound(BeamArray) - 1
        For j = i + 1 To UBound(BeamArray)
            If BeamArray(i).InsertionPoint(0) > BeamArray(j).InsertionPoint(0) Then
                Set oHolder = BeamArray(j)
                Set BeamArray(j) = BeamArray(i)
                Set BeamArray(i) = oHolder
            End If
        Next
    Next


    For i = LBound(StringerArray) To UBound(StringerArray) - 1
        For j = i + 1 To UBound(StringerArray)
            If StringerArray(i).InsertionPoint(1) > StringerArray(j).InsertionPoint(1) Then
                Set oHolder = StringerArray(j)
                Set StringerArray(j) = StringerArray(i)
                Set StringerArray(i) = oHolder
            End If
        Next
    Next
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\


'Declaring excel sheet formatting
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    With BeamSheet
        .Range("A:A").NumberFormat = "0.00#"
    End With
    
    With StringerSheet
        .Range("A:A").NumberFormat = "0.00#"
        .Range("D:D").NumberFormat = "0.00#"
        .Range("E:E").NumberFormat = "0.00#"
    End With
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\



'Write beams and stringers into excel sheet
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    With BeamSheet
        For irow = 1 To UBound(BeamArray) + 1
            Props = BeamArray(irow - 1).GetDynamicBlockProperties
            
            For i = LBound(Props) To UBound(Props)
                If Props(i).PropertyName = "Visibility1" Then
                    .Cells(irow, 2) = Props(i).Value
                End If
            Next
            
            If .Cells(irow, 1) > BeamArray(irow - 1).InsertionPoint(0) Then
                .Cells(irow, 3) = "Left"
            Else
                .Cells(irow, 3) = "Right"
            End If
        Next
    End With
    
    With StringerSheet
    
        LastInsertion = 0
    
        For irow = 1 To UBound(StringerArray) + 1
            rowCounter = irow
        
            If 0.005 > StringerArray(irow - 1).InsertionPoint(1) - LastInsertion Then
                Do While .Cells(rowCounter, 1) <> ""
                    rowCounter = rowCounter + 1
                Loop
                
                For i = rowCounter To irow Step -1
                    .Cells(i, 1) = .Cells(i - 1, 1)
                Next
            End If
            
            LastInsertion = StringerArray(irow - 1).InsertionPoint(1)
            
            Props = StringerArray(irow - 1).GetDynamicBlockProperties
            
            For i = LBound(Props) To UBound(Props)
                If Props(i).PropertyName = "Visibility1" Then
                    .Cells(irow, 2) = Props(i).Value
                    oSize = Props(i).Value
                End If
                
                If Props(i).PropertyName = oSize & "_Length" Then oLength = Props(i).Value
            Next
            
            StartPoint = oSize & "StartPosition"
            EndPoint = oSize & "EndPosition"
            StringerArray(irow - 1).GetBoundingBox StartPoint, EndPoint
            
            .Cells(irow, 4) = StringerArray(irow - 1).InsertionPoint(0)
            
            If .Cells(irow, 1) < StringerArray(irow - 1).InsertionPoint(1) Then
                .Cells(irow, 3) = "Side C"
            Else
                .Cells(irow, 3) = "Side A"
            End If
        
                
            If EndPoint(0) < StartPoint(0) Then
                .Cells(irow, 5) = StringerArray(irow - 1).InsertionPoint(0) - oLength
            Else
                .Cells(irow, 5) = StringerArray(irow - 1).InsertionPoint(0) + oLength
            End If
        Next
    End With
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\


'Error Handler
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
ErrorHandler:
    If Err.Number = -2147352567 Then
        Call ErrorHandler(xlApp, xlBook, BeamSheet, StringerSheet)
        Exit Function
   End If
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

End Function


'Saves and Exits Excel
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Function ErrorHandler(xlApp, xlBook, BeamSheet, StringerSheet)
        
        xlApp.Save
        xlApp.Quit
    
        Set BeamSheet = Nothing
        Set StringerSheet = Nothing
        Set xlBook = Nothing
        Set xlApp = Nothing

End Function

[Thomas.Long · Accepted solution]

Apologies, upon further inspection I found that the insertionpoint property of a block was always based upon the UCS. I have amended my code with the TranslateCoordinates method in order to account for this error and it works properly now.