LISP for assigning layer color

February 18, 2008

Hi all,

I'm using Map 3D to import a large number of .shp files to set up my base file. The issue I have is all the objects come in with a layer color of "white". It's really hard to have any idea what layer an object is on by looking at the drawing.

My thought was a LISP that would assign a color to each layer perhaps just the first six colors. It would end up looking something like the following...

BLDG_1695_1160C -- Color 1

Default_BASEBALL -- Color 2

Default_BASEBALL_FUTURE -- Color 3

Default_BLDG_1695_1155A -- Color 4

Default_BLDG_1695_1155B -- Color 5

Default_BLDG_1695_1160B -- Color 6

Default_BLDG_1695_1160C -- Color 1

Default_BOUNDARY -- Color 2

Default_CENTERROW -- Color 3

Default_CONINDEXDES -- Color 4

Default_CONINTERDES -- Color 5

Default_CONTEXTDES -- Color 6

Default_ESMT -- Color 1

Default_EXEDGPVMT -- Color 2

Is there a LISP that will assign a different color to the layers?

Thanks in advance

Toney

February 18, 2008

Do you want a random color or a predetermined color?

The following will assign a different color (in order from 1-255) to each layer. If you want a random color, there is a random number generator in lisp here. If you want a specific color per layer, then you will have to set up some sort of mapping list so it will know what color to use for each layer.

(vl-load-com)
(defun C:Lcolor ( / c x)
 (setq c 1)
 (vlax-for
   x
   (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)))
   (vla-put-Color x c)
   (if (eq c 255)
     (setq c 1)
     (setq c (1+ c))
   )
 )
)

February 18, 2008

Try this. All layers in the list must be unlocked and unfrozen.

(defun c:layd(/ Lst curLay fLst laySet)
 
 (setq Lst (list
'("BLDG_1695_1160C" 1)
'("Default_BASEBALL" 2)
'("Default_BASEBALL_FUTURE" 3)
'("Default_BLDG_1695_1155A" 4)
'("Default_BLDG_1695_1155B" 5)
'("Default_BLDG_1695_1160B" 6)
'("Default_BLDG_1695_1160C" 1)
'("Default_BOUNDARY" 2)
'("Default_CENTERROW" 3)
'("Default_CONINDEXDES"	4)
'("Default_CONINTERDES" 5)
'("Default_CONTEXTDES" 6)
'("Default_ESMT" 1)
'("Default_EXEDGPVMT" 2)
); end list
); end setq

 (vl-load-com)

 (foreach lay Lst
   (if
     (not
(vl-catch-all-error-p
  (setq curLay(vl-catch-all-apply 'vla-Item
     (list(vla-get-Layers
	     (vla-get-ActiveDocument
		  (vlax-get-acad-object)))(car lay))))))
     (progn
(vla-put-Color curLay(cadr lay))
(setq fLst(list(cons 8(vla-get-Name curLay))))
(if
  (setq laySet(ssget "_X" fLst))
  (progn
    (foreach itm
	     (mapcar 'vlax-ename->vla-object 
                      (vl-remove-if 'listp 
                        (mapcar 'cadr(ssnamex laySet))))
      (vla-put-Color itm acByLayer)
    ); end foreach
  ); end if
); end progn
   ); end progn
 ); end if
); end foreach
 (princ)
 ); end of c:layd

July 1, 2008

insted of color to layer can we attach material name to particular layer then render by using lisp

July 1, 2008

> shamsam1

Has read your PM:

(defun c:pumat(/ Lst sSet mLst cMat sCnt lCnt mCnt eCnt)

(vl-load-com)
 
 (setq Lst (list
       '("0" "Global")
       '("Layer1" "Material 1")
       '("Layer2" "Material 2")
     ); end list
           ); end setq

 (vl-load-com)
 
(if(setq sSet(ssget "_X" '((0 . "*SOLID"))))
 (progn
   (setq sCnt 0 lCnt 0)
   (vlax-for mat (vla-get-Materials
           (vla-get-ActiveDocument
	     (vlax-get-acad-object)))
     (setq mLst(cons(vla-get-Name mat)mLst))
     ); end vlax-for
   (foreach itm
       (mapcar 'vlax-ename->vla-object 
         (vl-remove-if 'listp 
           (mapcar 'cadr(ssnamex sSet))))
      (if(setq cMat
		(cadr
		  (assoc
		    (setq cLay(vla-get-Layer itm))Lst)))
	(if(member cMat mLst)
	  (if(vl-catch-all-error-p
	       (vl-catch-all-apply 'vla-put-Material
		 (list itm cMat)))
	    (setq lCnt(1+ lCnt))
	    (setq sCnt(1+ sCnt))
	    ); end if
	  (if(not(member cMat mCnt))
	   (setq mCnt(cons cMat mCnt))
	    ); end if
	  ); end if
	(if(not(member cLay eCnt))
	  (setq eCnt(cons cLay eCnt))
	  ); end if
       );end if
    ); end foreach
   (if(or(/= 0 lCnt)(/= 0(length mCnt))(/= 0(length eCnt)))
     (progn
(princ "\n========================= ERROR LIST =========================\n")
(if(/= 0(length mCnt))
  (progn
    (princ "\nFollowing materials missed in drawing: \n")
    (foreach mat mCnt
      (princ(strcat "\n " mat))
      ); end foreach
    (princ "\n")
    ); end progn
  ); end if
      (if(/= 0(length eCnt))
  (progn
    (princ "\nSome solid layers missed in list: \n")
    (foreach lay eCnt
      (princ(strcat "\n " lay))
      ); end foreach
    (princ "\n")
    ); end progn
  ); end if
 (if(/= 0 lCnt)
   (princ(strcat "\n" (itoa lCnt) " were on locked layer!\n"))
  ); end if
(princ "\n========================== END LIST ==========================\n")
(textscr)
); end progn
     ); end if
     	(princ(strcat "\n<<< Materials are appropriated for "
	      (itoa sCnt) " of "
	      (itoa(sslength sSet)) " solids >>>"))
   ); end progn
 (princ "\n<!> No Solids Found <!> ")
 ); end if
 (princ)
 ); end of c:pumat

July 2, 2008

You have 3/4 done it maybe a script will do

-layer

Color 1 BLDG_1695_1160C

Color 2 Default_BASEBALL

Color 3 Default_BASEBALL_FUTURE

Color 4 Default_BLDG_1695_1155A

etc etc

Default_BLDG_1695_1155B -- Color 5

Default_BLDG_1695_1160B -- Color 6

July 2, 2008

> BIGAL

Last guy want to attach materials to solids on certain layers, can you make it with script?

July 2, 2008

Hi ASMI,

Thanks for ur reply.While running the script the folowing error is displaying,

error: no function definition: VLA-GET-MATERIALS

Can u help in resolving this.

Regards,

Shamsam1

July 2, 2008

Oops!

Exuse me. Please add (vl-load-com) expressions to begin or end of file. VLA-functions don't work without it. Or copy listing one more time. I just add it.

July 2, 2008

after adding (vl-load-com) at the begning still i am getting same error..

my knowlede of lisp is nill

this is where i have modified

(defun c:pumat(/ Lst sSet mLst cMat sCnt lCnt mCnt eCnt)

(vl-load-com)

(setq Lst (list

'("Layer1" "APE BUMP")

); end list

); end setq

VLA-GET-MATERIALS is error i get again

July 2, 2008

I think Mechanical 2000 is a reason That's a pity, but I can't test it with this Autodesk product. I know that Object Model of Autodesk Mechanical has the big distinctions from plane AutoCAD or ADT. But I try to help you. Please type in command line (vl-load-com), than copy to command line:

(vlax-dump-object(vla-get-ActiveDocument(vlax-get-acad-object))t)

Press F2 and get long list of properties and methods of Mechanical 2000 document like this (from plane 2008 ).

Command: (vl-load-com)

Command: (vlax-dump-object(vla-get-ActiveDocument(vlax-get-acad-object))t)

; IAcadDocument: An AutoCAD drawing
; Property values:
;   Active (RO) = -1
;   ActiveDimStyle = #<VLA-OBJECT IAcadDimStyle 0785c98c>
;   ActiveLayer = #<VLA-OBJECT IAcadLayer 0785c9dc>
;   ActiveLayout = #<VLA-OBJECT IAcadLayout 0785c89c>
;   ActiveLinetype = #<VLA-OBJECT IAcadLineType 0785c93c>
;   ActiveMaterial = #<VLA-OBJECT IAcadMaterial 0785c84c>
;   ActivePViewport = AutoCAD: No active viewport in paperspace
;   ActiveSelectionSet (RO) = #<VLA-OBJECT IAcadSelectionSet 0784fb1c>
;   ActiveSpace = 1
;   ActiveTextStyle = #<VLA-OBJECT IAcadTextStyle 0785ca2c>
;   ActiveUCS = AutoCAD: Null object ID
;   ActiveViewport = #<VLA-OBJECT IAcadViewport 0785ca7c>
;   Application (RO) = #<VLA-OBJECT IAcadApplication 00d73d3c>
;   Blocks (RO) = #<VLA-OBJECT IAcadBlocks 0785cacc>
;   Database (RO) = #<VLA-OBJECT IAcadDatabase 0784fbdc>
;   Dictionaries (RO) = #<VLA-OBJECT IAcadDictionaries 0785cb1c>
;   DimStyles (RO) = #<VLA-OBJECT IAcadDimStyles 0785cb6c>
;   ElevationModelSpace = 0.0
;   ElevationPaperSpace = 0.0
;   FileDependencies (RO) = #<VLA-OBJECT IAcadFileDependencies 02105024>
;   FullName (RO) = ""
;   Groups (RO) = #<VLA-OBJECT IAcadGroups 0785cbbc>
;   Height = 776
;   HWND (RO) = 66802
;   Layers (RO) = #<VLA-OBJECT IAcadLayers 0785cc0c>
;   Layouts (RO) = #<VLA-OBJECT IAcadLayouts 0785cc5c>
;   Limits = (0.0 0.0 420.0 297.0)
;   Linetypes (RO) = #<VLA-OBJECT IAcadLineTypes 0785ccac>
;   Materials (RO) = #<VLA-OBJECT IAcadMaterials 0785ccfc>
;   ModelSpace (RO) = #<VLA-OBJECT IAcadModelSpace2 0785cd4c>
;   MSpace = AutoCAD: Invalid mode
;   Name (RO) = "Drawing1.dwg"
;   ObjectSnapMode = 0
;   PaperSpace (RO) = #<VLA-OBJECT IAcadPaperSpace2 0785cd9c>
;   Path (RO) = "C:\\Documents and Settings\\Alexander\\My Documents"
;   PickfirstSelectionSet (RO) = #<VLA-OBJECT IAcadSelectionSet 0784fe1c>
;   Plot (RO) = #<VLA-OBJECT IAcadPlot 02104ec4>
;   PlotConfigurations (RO) = #<VLA-OBJECT IAcadPlotConfigurations 0785cdec>
;   Preferences (RO) = #<VLA-OBJECT IAcadDatabasePreferences 02105204>
;   ReadOnly (RO) = 0
;   RegisteredApplications (RO) = #<VLA-OBJECT IAcadRegisteredApplications 
0785ce3c>
;   Saved (RO) = -1
;   SectionManager (RO) = Exception occurred
;   SelectionSets (RO) = #<VLA-OBJECT IAcadSelectionSets 0214c4e4>
;   SummaryInfo (RO) = #<VLA-OBJECT IAcadSummaryInfo 02105394>
;   TextStyles (RO) = #<VLA-OBJECT IAcadTextStyles 0785ce8c>
;   UserCoordinateSystems (RO) = #<VLA-OBJECT IAcadUCSs 0785cedc>
;   Utility (RO) = #<VLA-OBJECT IAcadUtility 0783fe6c>
;   Viewports (RO) = #<VLA-OBJECT IAcadViewports 0785cf2c>
;   Views (RO) = #<VLA-OBJECT IAcadViews 0785cf7c>
;   Width = 1558
;   WindowState = 3
;   WindowTitle (RO) = "Drawing1.dwg"
; Methods supported:
;   Activate ()
;   AuditInfo (1)
;   Close (2)
;   CopyObjects (3)
;   EndUndoMark ()
;   Export (3)
;   GetVariable (1)
;   HandleToObject (1)
;   Import (3)
;   LoadShapeFile (1)
;   New (1)
;   ObjectIdToObject (1)
;   Open (2)
;   PurgeAll ()
;   Regen (1)
;   Save ()
;   SaveAs (3)
;   SendCommand (1)
;   SetVariable (2)
;   StartUndoMark ()
;   Wblock (2)
T

Please publish this list I need to look it.

July 2, 2008

for testing i am using autcad2000

Command: (vl-load-com)

Command: (vlax-dump-object(vla-get-ActiveDocument(vlax-get-acad-object))t)

; IAcadDocument: An AutoCAD drawing

; Property values:

; Active (RO) = -1

; ActiveDimStyle = #

; ActiveLayer = #

; ActiveLayout = #

; ActiveLinetype = #

; ActivePViewport = AutoCAD: No active viewport in paperspace

; ActiveSelectionSet (RO) = #

; ActiveSpace = 1

; ActiveTextStyle = #

; ActiveUCS = #

; ActiveViewport = #

; Application (RO) = #

; Blocks (RO) = #

; Database (RO) = #

; Dictionaries (RO) = #

; DimStyles (RO) = #

; ElevationModelSpace = 0.0

; ElevationPaperSpace = 0.0

; FullName (RO) = ""

; Groups (RO) = #

; Height = 564

; HWND (RO) = 198838

; Layers (RO) = #

; Layouts (RO) = #

; Limits = (0.0 0.0 12.0 9.0)

; Linetypes (RO) = #

; ModelSpace (RO) = #

; MSpace = AutoCAD: Invalid mode

; Name (RO) = "Drawing1.dwg"

; ObjectSnapMode = 0

; PaperSpace (RO) = #

; Path (RO) = "D:"

; PickfirstSelectionSet (RO) = #

; Plot (RO) = #

; PlotConfigurations (RO) = #

; Preferences (RO) = #

; ReadOnly (RO) = 0

; RegisteredApplications (RO) = #

016d2084>

; Saved (RO) = 0

; SelectionSets (RO) = #

; TextStyles (RO) = #

; UserCoordinateSystems (RO) = #

; Utility (RO) = #

; Viewports (RO) = #

; Views (RO) = #

; Width = 978

; WindowState = 3

; WindowTitle (RO) = "Drawing1"

; Methods supported:

; Activate ()

; AuditInfo (1)

; Close (2)

; CopyObjects (3)

; EndUndoMark ()

; Export (3)

; GetVariable (1)

; HandleToObject (1)

; Import (3)

; LoadShapeFile (1)

; New (1)

; ObjectIdToObject (1)

; Open (1)

; PurgeAll ()

; Regen (1)

; Save ()

; SaveAs (2)

; SendCommand (1)

; SetVariable (2)

; StartUndoMark ()

; Wblock (2)

July 2, 2008

That is weird. 'Materials' collection and 'ActiveMateial' properties missed I don't know how to help you You can open Developer Help>ActiveX andVBA Refference>Properties and try to find 'Materials property'. If it is I want to look owner objects. Like in usual Autocad:

Returns the materials collection for the database.

See Also | Example

Signature

object.Materialsobject

Database, Document

The object or objects to which this property applies.

Materials

AcadMaterials; input-only

July 29, 2008

Please help me to combine 2 lisp program and make it one.

Adding materials and adding color lisp program i want to combine.

Please guide me regarding this

August 14, 2008

Please help me to combine 2 lisp program and make it one.

Adding materials and adding color lisp program i want to combine.

Please guide me regarding this

There is. Last member of each member of list 'Lst' is a color (0 - 255).

(defun c:pumc(/ actDoc Lst sSet mLst cMat sCnt l
      Cnt mCnt eCnt cCol *error*)

(vl-load-com)
 
 (setq Lst (list
       '("0" "Global" 4)
       '("Layer1" "Material 1" 1)
       '("Layer2" "Material 2" 6)
     ); end list
           ); end setq

 (defun *error*(msg)
    (if actDoc(vla-EndUndoMark actDoc))
    (princ)
   ); end of error*

 (vl-load-com)
 
(if(setq sSet(ssget "_X" '((0 . "*SOLID"))))
 (progn
   (setq sCnt 0 lCnt 0)
   (vlax-for mat (vla-get-Materials
           (setq actDoc
	      (vla-get-ActiveDocument
	        (vlax-get-acad-object))))
     (setq mLst(cons(vla-get-Name mat)mLst))
     ); end vlax-for
  (vla-StartUndoMark actDoc)
   (foreach itm
       (mapcar 'vlax-ename->vla-object 
         (vl-remove-if 'listp 
           (mapcar 'cadr(ssnamex sSet))))
      (if(setq cMat
		(cadr
		  (assoc
		    (setq cLay(vla-get-Layer itm))Lst)))
	(if(member cMat mLst)
	  (if(vl-catch-all-error-p
	       (vl-catch-all-apply 'vla-put-Material
		 (list itm cMat)))
	    (setq lCnt(1+ lCnt))
	    (setq sCnt(1+ sCnt))
	    ); end if
	  (if(not(member cMat mCnt))
	   (setq mCnt(cons cMat mCnt))
	    ); end if
	  ); end if
	(if(not(member cLay eCnt))
	  (setq eCnt(cons cLay eCnt))
	  ); end if
       );end if
      (if(setq cCol
	(last
	   (assoc
	     (setq cLay(vla-get-Layer itm))Lst)))
 (if(vl-catch-all-error-p
      (vl-catch-all-apply 'vla-put-Color
	(list itm cCol))) nil
   ); end if
 ); end if
    ); end foreach
   (vla-EndUndoMark actDoc)
   (if(or(/= 0 lCnt)(/= 0(length mCnt))(/= 0(length eCnt)))
     (progn
(princ "\n========================= ERROR LIST =========================\n")
(if(/= 0(length mCnt))
  (progn
    (princ "\nFollowing materials missed in drawing: \n")
    (foreach mat mCnt
      (princ(strcat "\n " mat))
      ); end foreach
    (princ "\n")
    ); end progn
  ); end if
      (if(/= 0(length eCnt))
  (progn
    (princ "\nSome solid layers missed in list: \n")
    (foreach lay eCnt
      (princ(strcat "\n " lay))
      ); end foreach
    (princ "\n")
    ); end progn
  ); end if
 (if(/= 0 lCnt)
   (princ(strcat "\n" (itoa lCnt) " were on locked layer!\n"))
  ); end if
(princ "\n========================== END LIST ==========================\n")
(textscr)
); end progn
     ); end if
     	(princ(strcat "\n<<< Materials and colors are attached for "
	      (itoa sCnt) " of "
	      (itoa(sslength sSet)) " solids >>>"))
   ); end progn
 (princ "\n<!> No Solids Found <!> ")
 ); end if
 (princ)
 ); end of c:pumc

It can't work in 2005. I don't know in how version Materials collection becomes accessible to Visual LISP. Maybe in 2007 (R 17.0)?

August 14, 2008

thanks asmi....

LISP for assigning layer color

Recommended Posts

ajl_mo

Link to comment

Share on other sites

rkmcswain

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

shamsam1

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

shamsam1

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

shamsam1

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

shamsam1

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

shamsam1

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

shamsam1

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity