Maybe this help a litle beat more:
chears,
Luís Laíns
Public Sub PL_Areas()
Dim SSet1 As AcadSelectionSet
Dim I As Integer
Dim Xteste As Double
Dim PlineObj As AcadLWPolyline
'------------
Dim Excel As Object
Dim Newbook As Workbook
Dim excelSheet As Worksheet
Dim Count, RowNum As Integer
' Start Excel
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set Excel = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Não possível inicializar Excel.", vbExclamation
End
End If
End If
'---------------------
On Error Resume Next
Set SSet1 = ThisDrawing.SelectionSets.Item("SS1")
If Err Then
Err.Clear
Set SSet1 = ThisDrawing.SelectionSets.Add("SS1")
End If
On Error GoTo 0
Dim Entity As AcadEntity
On Error Resume Next
ReDim ssobjs(0 To ThisDrawing.ModelSpace.Count - 1) As AcadEntity
I = 0
'---------------------
Excel.Visible = True
Set Newbook = Excel.Workbooks.Add
Newbook.Sheets.Add.Name = 1
Set excelSheet = Newbook.Sheets(1)
RowNum = 1
excelSheet.Cells(RowNum, 1).Value = "Area"
'---------------------
For Each Entity In ThisDrawing.ModelSpace
If (Entity.ObjectName = "AcDbPolyline") Then
Set ssobjs(I) = Entity
Set PlineObj = ssobjs(I)
RowNum = RowNum + 1
excelSheet.Cells(RowNum, 1).Value = Round(PlineObj.Area, 3)
I = I + 1
End If
Next Entity
'--------------------
Excel.Application.Quit
Set Excel = Nothing
Set Newbook = Nothing
Set excelSheet = Nothing
'--------------------
End Sub
"Luís Laíns "
<=?UTF-8?Q?Lu=C3=ADs_La=C3=ADns_?=> wrote in message
news:5662919@discussion.autodesk.com...
1. Select all poly in drawing
2. Loop them and use the propertie area
Dim a As AcadLWPolyline
a.Area
Luis
wrote in message news:5662837@discussion.autodesk.com...
hi
how can I calculate area of each polyline in drawing by using vba?
thanks
