AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

Here's a handy little VBA function :

'CODING STARTS HERE
Public Sub ColorToEntity()
'This subroutine sets each entities color from ByLayer
'to the color of the layer it's on.

Dim objEntity As AcadEntity
Dim objMS As AcadModelSpace
Dim objPS As AcadPaperSpace
Dim objLayers As AcadLayers
Dim objLayer As AcadLayer
Dim strLayer As String

Set objMS = ThisDrawing.ModelSpace
Set objPS = ThisDrawing.PaperSpace
Set objLayers = ThisDrawing.Layers
'process ents in modelspace
For Each objEntity In objMS
strLayer = objEntity.Layer
Set objLayer = objLayers.Item(strLayer)
objEntity.Color = objLayer.Color
Next objEntity
'process ents in paperspace
For Each objEntity In objPS
strLayer = objEntity.Layer
Set objLayer = objLayers.Item(strLayer)
objEntity.Color = objLayer.Color
Next objEntity

End Sub
'CODING ENDS HERE

The AutoLisp/Visual Lisp/VBA Resource Website

Copyright 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website