Automate the renaming of lights.

[cliffwd]

I am using an old version of AutoCAD 2005.

I often add lights into a drawing as blocks and then explode them into individual light sources.  This works well except the lights are all named the same "LT8-01".  I have to rename them to be unique or when I render only the first one inserted will light up.

I have written many VBA application to help speed the operations I do most often.  This one has stumped me.  I can't seem to find a way to get to the light collection through VBA and reanam the lights.  This means the only way I can rename them is manually through the light dialog.  The one the comes up by typing LIGHT on the command line (See attchment screen shot).  When there are 50+ lights this becomes time consuming.  I am able to get to the SNAME attribute and rename that, but that does not actually rename the light object.

Anyone have a piece of code that will rename the lights so they are all unique.

Much appreciated in advance.

Cliff

[HJohn1]

In VBA you could create a SelectionSet with all the lights in the drawing by filtering for (0 . "LIGHT" ).  I am not sure if you could get access to the AcDbLight object through VBA, but you still can rename it by using the NAME property.  Here is a quick example. Hope it helps.

Public Sub RenameLights()
Dim SELECTIONSECTNAME As String
Dim ss As AcadSelectionSet
Dim fil(0) As Integer
Dim dat(0) As Variant
Dim ent As AcadEntity
Dim index As Integer

SELECTIONSECTNAME = "$LIGHT_ENTITIES$"

On Error GoTo ERRORTRAP

fil(0) = 0
dat(0) = "LIGHT"

Set ss = ThisDrawing.SelectionSets.Add(SELECTIONSECTNAME)
ss.Select acSelectionSetAll, , , fil, dat

index = 1

If ss.Count > 0 Then
    For Each ent In ss
        ent.Name = "Light_" & CStr(index)
        index = index + 1
    Next ent
    ss.Delete
End If

Exit Sub

ERRORTRAP:

If ThisDrawing.SelectionSets.Count > 0 Then
    For Each ss In ThisDrawing.SelectionSets
        If ss.Name = SELECTIONSECTNAME Then
            ss.Delete
            Resume
        End If
    Next ss
Else
    MsgBox Err.Description
End If

End Sub