ajl_mo Posted February 18, 2008 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
rkmcswain Posted February 18, 2008 Share Posted 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)) ) ) ) Quote Link to comment Share on other sites More sharing options...
ASMI Posted February 18, 2008 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
shamsam1 Posted July 1, 2008 Share Posted July 1, 2008 insted of color to layer can we attach material name to particular layer then render by using lisp Quote Link to comment Share on other sites More sharing options...
ASMI Posted July 1, 2008 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 2, 2008 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
ASMI Posted July 2, 2008 Share Posted July 2, 2008 > BIGAL Last guy want to attach materials to solids on certain layers, can you make it with script? Quote Link to comment Share on other sites More sharing options...
shamsam1 Posted July 2, 2008 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
ASMI Posted July 2, 2008 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
shamsam1 Posted July 2, 2008 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
ASMI Posted July 2, 2008 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
shamsam1 Posted July 2, 2008 Share Posted 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) Quote Link to comment Share on other sites More sharing options...
ASMI Posted July 2, 2008 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
shamsam1 Posted July 29, 2008 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
ASMI Posted August 14, 2008 Share Posted 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)? Quote Link to comment Share on other sites More sharing options...
shamsam1 Posted August 14, 2008 Share Posted August 14, 2008 thanks asmi.... Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.