Skip to content

Entity

Loop Through Entity

Public Sub Test()
    On Error GoTo ErrorHandler

    'Autocad Application
    Dim cadApp As AutoCAD.AcadApplication
    Set cadApp = GetObject(, "autocad.application")

    'Autocad Document
    Dim cadDoc As AutoCAD.AcadDocument
    Set cadDoc = cadApp.ActiveDocument

    'Autocad ModelSpace
    Dim cadModel As AutoCAD.AcadModelSpace
    Set cadModel = cadDoc.ModelSpace

    'Loop through each entity
    Dim i As Integer
    Dim entity As AutoCAD.AcadEntity

    For i = 0 To cadModel.Count - 1
        Set entity = cadModel.Item(i)
        Debug.Print entity.Name
    Next


Done:
    Exit Sub
ErrorHandler:
    If Err.Description <> "" Then
        MsgBox (Err.Description)
    End If
End Sub

Loop Through Selected Items

Sub Test()
    On Error GoTo ErrorHandler

    'Autocad Application
    Dim aCadApp As AutoCAD.aCadApplication
    Set aCadApp = GetObject(, "autocad.application")

    'Autocad Document
    Dim aCadDoc As AutoCAD.AcadDocument
    Set aCadDoc = aCadApp.ActiveDocument

    Dim entity As AutoCAD.AcadEntity
    Dim mtext As AutoCAD.AcadMText

    Sheet1.range("A1").CurrentRegion.ClearContents

    Dim rowId As Integer
    rowId = 1

    'Code to Loop Through all Items in AutoCAD
    For Each entity In aCadDoc.ModelSpace
        If entity.ObjectName = "AcDbMText" Then
            Set mtext = entity
            With Sheet1
                .Cells(rowId, 1) = mtext.InsertionPoint(0)
                .Cells(rowId, 2) = mtext.InsertionPoint(1)
                .Cells(rowId, 3) = mtext.TextString
            End With
            rowId = rowId + 1
        End If
    Next

    'Code to Loop Though User Selected Items
    Dim aCadSelectionSet As AutoCAD.aCadSelectionSet
    Set aCadSelectionSet = aCadDoc.SelectionSets.Add("Testddd")
    aCadSelectionSet.SelectOnScreen

    For Each entity In aCadSelectionSet

        If entity.ObjectName = "AcDbMText" Then
            Set mtext = entity
            With Sheet1
                .Cells(rowId, 1) = mtext.InsertionPoint(0)
                .Cells(rowId, 2) = mtext.InsertionPoint(1)
                .Cells(rowId, 3) = mtext.TextString
            End With
            rowId = rowId + 1
        End If
    Next

    aCadSelectionSet.Delete

    'Code to Loop Through Already Selected Items

    Dim aCadSelectionSet As AutoCAD.aCadSelectionSet
    Set aCadSelectionSet = aCadDoc.SelectionSets.Add(Now)
    aCadSelectionSet.Select acSelectionSetPrevious

    For Each entity In aCadSelectionSet

        If entity.ObjectName = "AcDbMText" Then
            Set mtext = entity
            With Sheet1
                .Cells(rowId, 1) = mtext.InsertionPoint(0)
                .Cells(rowId, 2) = mtext.InsertionPoint(1)
                .Cells(rowId, 3) = mtext.TextString
            End With
            rowId = rowId + 1
        End If
    Next

    '    aCadSelectionSet.Delete

Done:
    Exit Sub
ErrorHandler:
    If Err.Description <> "" Then
        MsgBox (Err.Description)
    End If

End Sub