Sittingbull Posted December 13, 2010 Share Posted December 13, 2010 Hi, I found this verry nice routine on the forum, dunno who i have to thank for this though(gilsoto13?). I've tested these lisps at home on a CAD 2011. Works fine. But on a CAD 2007 Electrical i get this error: ; error: bad argument type: lselsetp nil I looked up on the net, and found it would be related to a selection set(lisp-selection-set-predicate)? Like the routine expects a slection, or my selection set is nil? Should i ad a -p somewhere, from that predicate stuff? here is the code: ;;function to rename a layer. ;;if old layer exists, and new layer doesn't exist, the old layer is simply renamed. ;;if old layer exists, and new layer is already there, it takes everything on old layer and puts them on new layer. ;;if old layer doesn't exist, it does nothing. (defun renlay (ol nl / ss i ent ) (cond ((and (tblsearch "layer" ol) (not (tblsearch "layer" nl))) (command "._rename" "la" ol nl) ) ((and (tblsearch "layer" ol)(tblsearch "layer" nl)) (setq ss (ssget "x" (list (cons 8 ol)))) (setq i -1) (repeat (sslength ss) (setq ent (entget (ssname ss (setq i (1+ i)))) ent (subst (cons 8 nl) (cons 8 (cdr (assoc 8 ent))) ent) ) (entmod ent) ) ) ((not (tblsearch "layer" ol)) (prompt (strcat "\nLayer " ol " not found. ")) ) ) (princ) ) ;;example (defun c:test () (renlay "ENG" "GE_TXT_LANGUAGE_EN") (renlay "NL" "GE_TXT_LANGUAGE_DU") (renlay "DUITS" "GE_TXT_LANGUAGE_GE") (renlay "FR" "GE_TXT_LANGUAGE_FR") ) Thx in advance. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted December 13, 2010 Share Posted December 13, 2010 Perhaps try something like this: (defun RenameLayer ( old new ) ;; © Lee Mac 2010 (if (tblsearch "LAYER" old) (if (tblsearch "LAYER" new) (if (setq ss (ssget "_X" (list (cons 8 old)))) ( (lambda ( i ) (while (setq e (ssname ss (setq i (1+ i)))) (entupd (cdr (assoc -1 (entmod (list (assoc -1 (entget e)) (cons 8 new)) ) ) ) ) ) ) -1 ) ) ( (lambda ( old ) (entmod (subst (cons 2 new) (assoc 2 old) old ) ) ) (entget (tblobjname "LAYER" old)) ) ) (princ (strcat "\n--> Layer: " old " not found.")) ) (princ) ) (defun c:test ( / o n ) (if (and (setq o (getstring t "\nSpecify Layer to be Renamed: ")) (setq n (getstring t "\nSpecify New Layer Name: ")) ) (RenameLayer o n) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
Sittingbull Posted December 13, 2010 Author Share Posted December 13, 2010 Thx Lee, It works fine, but i think its not helping much. See, i would like to proces like a 1300 files. They all need to have layers created and some renamed. To create the layers i'll use some of your codes iff u don't mind: (defun MakeLayer ( name colour linetype lineweight willplot bitflag description ) ;; © Lee Mac 2010 (or (tblsearch "LAYER" name) (entmake (append (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 name) (cons 70 bitflag) (cons 290 (if willplot 1 0)) (cons 6 (if (and linetype (tblsearch "LTYPE" linetype)) linetype "CONTINUOUS" ) ) (cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7)) (cons 370 (fix (* 100 (if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0) ) ) ) ) (if description (list (list -3 (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description)) ) ) ) ) ) ) ) (defun c:MakeLayers nil (vl-load-com) ;; © Lee Mac 2010 ;; Specifications: ;; Description Data Type Remarks ;; ----------------------------------------------------------------- ;; Layer Name STRING Only standard chars allowed ;; Layer Colour INTEGER may be nil, -ve for Layer Off, Colour < 256 ;; Layer Linetype STRING may be nil, If not loaded, CONTINUOUS. ;; Layer Lineweight REAL may be nil, 0 <= x <= 2.11 ;; Plot? BOOLEAN T = Plot Layer, nil otherwise ;; Bit Flag INTEGER 0=None, 1=Frozen, 2=Frozen in VP, 4=Locked ;; Description STRING may be nil for no description ;; Function will return list detailing whether layer creation is successful. ( (lambda ( lst / lts ) (setq lts (vla-get-Linetypes (vla-get-ActiveDocument (vlax-get-acad-object)))) (mapcar 'cons (mapcar 'car lst) (mapcar (function (lambda ( x ) (and (caddr x) (or (tblsearch "LTYPE" (caddr x)) (vl-catch-all-apply 'vla-load (list lts (caddr x) "acad.lin")) ) ) (apply 'MakeLayer x) ) ) lst ) ) ) '( ; Name Colour Linetype Lineweight Plot? BitFlag Description ( "CEN" 6 "CENTER" 0.18 T 0 nil ) ( "DIMS" -1 nil 0.18 T 0 nil ) ( "HAT" 3 nil 0.18 T 0 nil ) ( "HID" 4 "HIDDEN" 0.15 T 0 "Hidden" ) ( "LOGO" 176 nil 0.09 T 0 "For Logo" ) ( "OBJ" -2 nil 0.40 T 0 nil ) ( "PAPER" 5 "PHANTOM" nil T 0 nil ) ( "PHAN" 6 "PHANTOM" 0.18 T 0 nil ) ( "TITLE" 176 nil nil T 0 "For Title" ) ( "TXT" 7 nil nil T 0 nil ) ) ) ) But i still need to include the previous code to rename them. It works great on 2011 + i can batch process it by linkin it to an scr. Any id on how to prevent this "lselsetp nil"? ++ Quote Link to comment Share on other sites More sharing options...
CADkitt Posted December 13, 2010 Share Posted December 13, 2010 I use these lisps I think there are also from cadtutor so you could search here a bit more . Do this once in batch on all drawings and all old layers are RIP. (dolayers);creates new layers if not already there. (setlayernew);will merge all old layers that are set with the new ones. This will do what layer translater does but then in 1 second You do need always the same old layers but mostly that is the case. ;;function to rename a layer. ;;if old layer exists, and new layer doesn't exist, the old layer is simply renamed. ;;if old layer exists, and new layer is already there, it takes everything on old layer and puts them on new layer. ;;if old layer doesn't exist, it does nothing. (defun renlay (ol nl / ss i ent ) (cond ((and (tblsearch "layer" ol) (not (tblsearch "layer" nl))) (command "._rename" "la" ol nl) ) ((and (tblsearch "layer" ol)(tblsearch "layer" nl)) (command "-LAYMRG" "N" ol "" "N" nl "Y") ) ((not (tblsearch "layer" ol)) (prompt (strcat "\nLayer " ol " not found. ")) ) ) (princ) ) ;;example (defun c:setlayernew () (command "-layer" "s" "0" "") (renlay "1" "01 Dimensions") (renlay "2" "02 Project dimensions notes") (renlay "8" "05 Center") (renlay "9" "08 Surrounding") (renlay "11" "05 Center") (renlay "13" "13 Border") (renlay "BORDER" "13 Border") (renlay "BORDER-V" "13 Border") (renlay "HORIZONTAL REF BOX" "0") (renlay "LOGO" "01 Dimensions") (renlay "3D" "0") (renlay "3d" "0") (renlay "Dimension (ISO)" "01 Dimensions") (renlay "Visible (ISO)" "0") (renlay "Visible Narrow (ISO)" "0") (renlay "Border (ISO)" "13 Border") (renlay "Title (ISO)" "13 Border") (princ)(princ "Layers renamed and merged") ) (defun MkLay (Nme Col lTyp lWgt Plt / lays lay) (vl-load-com) (setq lays (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) lay (cond ((tblsearch "LAYER" Nme) (vla-item lays Nme)) (t (vla-add lays Nme)))) (and Col (vla-put-Color lay Col)) (and lTyp (lTload lTyp) (vla-put-Linetype lay lTyp)) (and lWgt (vla-put-LineWeight lay (eval (read (strcat "acLnWt" lWgt))))) (and (not Plt) (vla-put-Plottable lay :vlax-false))) (defun lTload (lTyp) (or (tblsearch "LTYPE" lTyp) (vla-load (vla-get-Linetypes (vla-get-ActiveDocument (vlax-get-acad-object))) lTyp "acad.lin"))) (defun c:DoLayers ( / ) (vl-load-com) (mapcar 'MkLay '( "01 Dimensions" "02 Project dimensions notes" ) ; Name [str] '( 1 nil ) ; Colours [int] '( nil nil ) ; LineType [str] '( nil nil ) ; LineWeight [str] 0.18 = "018" '( T T )) ; Plottable (T or nil) (princ)(princ "New layers set") (princ)) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted December 13, 2010 Share Posted December 13, 2010 Any id on how to prevent this "lselsetp nil"? Yes, you check for a valid SelectionSet, which my code does. Are you saying you still receive the error? Quote Link to comment Share on other sites More sharing options...
David Bethel Posted December 13, 2010 Share Posted December 13, 2010 You may want to use something like this: [b][color=BLACK]([/color][/b]defun c:mrenlay [b][color=FUCHSIA]([/color][/b]/ ll nl ss tdef fe fd[b][color=FUCHSIA])[/color][/b] [color=#8b4513];;;LAYER LISTS *** UPPER CASE[/color] [b][color=FUCHSIA]([/color][/b]setq ll '[b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b][color=#2f4f4f]"3D"[/color] . [color=#2f4f4f]"232-RENDER"[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b][color=#2f4f4f]"2D"[/color] . [color=#2f4f4f]"204-2D-ONLY"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]defun SetLayer [b][color=NAVY]([/color][/b]name / ldef flag[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]command [color=#2f4f4f]"_.LAYER"[/color][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]tblsearch [color=#2f4f4f]"LAYER"[/color] name[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_Make"[/color] name[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]progn [b][color=GREEN]([/color][/b]setq ldef [b][color=BLUE]([/color][/b]tblsearch [color=#2f4f4f]"LAYER"[/color] name[b][color=BLUE])[/color][/b] flag [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 70 ldef[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]= [b][color=RED]([/color][/b]logand flag 1[b][color=RED])[/color][/b] 1[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]command [color=#2f4f4f]"_Thaw"[/color] name[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]minusp [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 62 ldef[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]command [color=#2f4f4f]"_On"[/color] name[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]= [b][color=RED]([/color][/b]logand flag 4[b][color=RED])[/color][/b] 4[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]command [color=#2f4f4f]"_Unlock"[/color] name[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]= [b][color=RED]([/color][/b]logand flag 16[b][color=RED])[/color][/b] 16[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]princ [color=#2f4f4f]"\nCannot Set To XRef Dependent Layer"[/color][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]quit[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]command [color=#2f4f4f]"_Set"[/color] name[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]command [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b] name[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]foreach l ll [b][color=NAVY]([/color][/b]SetLayer [b][color=MAROON]([/color][/b]cdr l[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]setq ss [b][color=GREEN]([/color][/b]ssget [color=#2f4f4f]"X"[/color] [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cons 8 [b][color=PURPLE]([/color][/b]car l[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] ss [color=#2f4f4f]""[/color] [color=#2f4f4f]"_LA"[/color] [b][color=GREEN]([/color][/b]cdr l[b][color=GREEN])[/color][/b] [color=#2f4f4f]""[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq tdef [b][color=MAROON]([/color][/b]tblnext [color=#2f4f4f]"BLOCK"[/color] [b][color=GREEN]([/color][/b]not tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]princ [b][color=MAROON]([/color][/b]strcat [color=#2f4f4f]"\n"[/color] [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 2 tdef[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]setq fe [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc -2 tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]entmake tdef[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]while fe [b][color=MAROON]([/color][/b]setq fd [b][color=GREEN]([/color][/b]entget fe[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]setq nl [b][color=BLUE]([/color][/b]assoc [b][color=RED]([/color][/b]strcase [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 8 fd[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] ll[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setq fd [b][color=BLUE]([/color][/b]subst [b][color=RED]([/color][/b]cons 8 [b][color=PURPLE]([/color][/b]cdr nl[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]assoc 8 fd[b][color=RED])[/color][/b] fd[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]entmake fd[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq fe [b][color=GREEN]([/color][/b]entnext fe[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"ENDBLK"[/color][b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] Change the associative list 'll to your needs ("OLDLAYER" . "NEWLAYER") It is more of a brute force method, but: It does handle heavy polylines Handles locked layers Includes all BLOCK definitions -David Quote Link to comment Share on other sites More sharing options...
Sittingbull Posted December 13, 2010 Author Share Posted December 13, 2010 Whooohoooo! Thx CADkitt, works great! @Lee Are you saying you still receive the error? Nope. Your code worked just fine aswell Many thx to both of you. SB Quote Link to comment Share on other sites More sharing options...
Sittingbull Posted December 13, 2010 Author Share Posted December 13, 2010 thx David Quote Link to comment Share on other sites More sharing options...
wrha Posted December 14, 2010 Share Posted December 14, 2010 also how can i change the dimension style name Quote Link to comment Share on other sites More sharing options...
CADkitt Posted December 15, 2010 Share Posted December 15, 2010 use -rename and then put it in (command "-rename" "dimstyle" "oldname" "newname") Quote Link to comment Share on other sites More sharing options...
wrha Posted December 15, 2010 Share Posted December 15, 2010 but how i can put that style and standard layer in all dwg i open it . Quote Link to comment Share on other sites More sharing options...
Cylis0509 Posted February 4, 2015 Share Posted February 4, 2015 CADkitt, this is great code!! I was wondering if it could be modified so that once it changes the layer name it changes the color and adds a description. Is that possible? Thank you in advance. Quote Link to comment Share on other sites More sharing options...
CADkitt Posted February 6, 2015 Share Posted February 6, 2015 I just logged in since 3 years ago or something. Solidworks is a great program..... I have not touched Autocad for the last 4 years, so I can't answer your question but it is probably in this part of the code, but i am not sure. (mapcar 'MkLay '( "01 Dimensions" "02 Project dimensions notes" ) ; Name [str] '( 1 nil ) ; Colours [int] '( nil nil ) ; LineType [str] '( nil nil ) ; LineWeight [str] 0.18 = "018" '( T T )) ; Plottable (T or nil) (princ)(princ "New layers set") (princ)) I don't know if you can do the description. My boss 4 years ago said to me when I ran this script, "why do you do this? now I could fire you", as I was on a hour basis contract. But I quitted a couple of months after that. Got bored very fast. Quote Link to comment Share on other sites More sharing options...
Commandobill Posted February 6, 2015 Share Posted February 6, 2015 Cylis, Just add vla-put-decription into the code previously provided, like this: (defun MkLay (Nme Col lTyp lWgt Plt descProp / lays lay) (vl-load-com) (setq lays (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) lay (cond ((tblsearch "LAYER" Nme) (vla-item lays Nme)) (t (vla-add lays Nme)))) (and Col (vla-put-Color lay Col)) (and lTyp (lTload lTyp) (vla-put-Linetype lay lTyp)) (and lWgt (vla-put-LineWeight lay (eval (read (strcat "acLnWt" lWgt))))) (and (not Plt) (vla-put-Plottable lay :vlax-false)) [color="red"](and descProp (vla-put-Description lay descProp))[/color]) 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.