TC (V7pro) VBA macro: Delete objects by colour - Ty Harness 25th August 2003

On the odd occasion you may want to delete all objects of a certain colour to simplify your drawing. Colour is often a good way distingish objects between CAD file formats.

Example: If you export a POSER3 model as a DXF then everthing ends up on one layer. In my case I only to extract the lower jaw bone (light grey). The upper skull (grey) and spine (black) was discarded.

I think I'll rewrite this macro to move all objects of the same colour to a separate layer.


Sub delcol()

Dim sel As Selection
Dim col As Long
Dim g As Graphic
Dim retval As Long

If ActiveDrawing.Selection.Count = 1 Then

Set g = ActiveDrawing.Selection.Item(0)
col = g.Properties("PenColor").Value

retval = MsgBox("One obeject has been pre-selected of colour: " & col _
& vbCr & "Continue to delete all similar coloured objects", vbYesNo)
ActiveDrawing.Selection.Unselect

If retval = vbYes Then

    For Each g In ActiveDrawing.Graphics
        If g.Properties("PenColor").Value = col Then
        g.Delete
        End If
    Next g

End If



Set g = Nothing

End If ' selection count =1

ActiveDrawing.ActiveView.ZoomToExtents



End Sub

Sub delcolhelp()
MsgBox "select one object with the same colour as all the objects you which to delete" _
& vbCr & "Run the delcol procedure"
End Sub

Home Page