Hello! Below you can see simple code (just to start with something).I did one main assumption:
User will select rectangles only (4 vertex, lineweight closed polylines).
When you select all of those rectangles, macro will collect data and put into your clipboard.
You need only to paste it into excel file with space character as separator.
Sub rectangleExport()
Dim oSelection As AcadSelectionSet
On Error Resume Next
Set oSelection = ThisDrawing.SelectionSets.Add("rectangles")
If Err.Number <> 0 Then
ThisDrawing.SelectionSets.Item("rectangles").Clear
Set oSelection = ThisDrawing.SelectionSets.Item("rectangles")
End If
oSelection.SelectOnScreen
Dim obJect As AcadObject
Dim oPol As AcadLWPolyline
Dim recArray() As String
Dim howMany As Integer
howMany = 0
Dim tempLine As AcadLine
Dim xMeasure As Double
Dim yMeasure As Double
Dim tempPoint1(2) As Double
Dim tempPoint2(2) As Double
If oSelection.Count = 0 Then
MsgBox "Nothing was selected"
oSelection.Delete
Exit Sub
End If
For Each obJect In oSelection
If TypeOf obJect Is AcadLWPolyline Then
Set oPol = obJect
ReDim Preserve recArray(howMany)
recArray(howMany) = oPol.Area
tempPoint1(0) = oPol.Coordinates(0): tempPoint1(1) = oPol.Coordinates(1): tempPoint1(2) = 0#
tempPoint2(0) = oPol.Coordinates(2): tempPoint2(1) = oPol.Coordinates(3): tempPoint2(2) = 0#
Set tempLine = ThisDrawing.ModelSpace.AddLine(tempPoint1, tempPoint2)
xMeasure = tempLine.Length
recArray(howMany) = recArray(howMany) & " " & xMeasure
tempLine.Delete
tempPoint1(0) = oPol.Coordinates(0): tempPoint1(1) = oPol.Coordinates(1): tempPoint1(2) = 0#
tempPoint2(0) = oPol.Coordinates(6): tempPoint2(1) = oPol.Coordinates(7): tempPoint2(2) = 0#
Set tempLine = ThisDrawing.ModelSpace.AddLine(tempPoint1, tempPoint2)
yMeasure = tempLine.Length
recArray(howMany) = recArray(howMany) & " " & yMeasure
tempLine.Delete
howMany = howMany + 1
End If
Next
Dim a As Integer
Dim mSg As String
mSg = "Area Width Length" & vbNewLine
For a = 0 To howMany - 1
mSg = mSg & recArray(a) & vbNewLine
Next a
Dim clipboard As MSForms.DataObject
Set clipboard = New MSForms.DataObject
clipboard.SetText mSg
clipboard.PutInClipboard
MsgBox howMany & " rectangles were found. Data is avaiable in your clipboard."
End Sub
