btraemoore Posted April 30, 2012 Author Share Posted April 30, 2012 Yup, sort of... i can write a snippet for you.... you didnt answer my question though, in the drawing there wouldn't be 2 layers with identical names, if there is ELECTRICAL/1/HIDDEN it will be renamed to elec and then move to the next layer in question.. here is the coding that i have so far (vl-load-com) (setq acadDocument (vla-get-activedocument (vlax-get-acad-object))) (setq layertable (vla-get-layers acadDocument)) (while (setq Lay (tblnext "LAYER" 1)) (setq layLT (cdr (assoc 6 lay)) layCOLOR (itoa (cdr (assoc 62 lay))) layNM (cdr (assoc 2 lay)) claylst (list laycolor laylt) );setq (setq f (open "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt" "r")) (while (/= dataline1 "eof") (setq dataline1 (read-line f)) (setq k 1) (setq a "") (setq lst nil) (setq laylst nil) (repeat (strlen dataline1) (if (= (substr dataline1 k 1) "\t") (progn (setq lst (append lst (list a))) (setq a "") );progn (setq a (strcat a (substr dataline1 k 1))) );if (setq k (+ k 1)) );repeat (setq lst (append lst (list a))) (setq lstlaynm (car (cdr (cons 1 lst)))) (if (/= lstlaynm laynm) (setq clst (cdr (cdr (cons 1 lst)))) (if (and (= (nth 1 clst)(nth 1 claylst))(= (nth 2 clst)(nth 2 claylst))) Quote Link to comment Share on other sites More sharing options...
pBe Posted April 30, 2012 Share Posted April 30, 2012 btraemoore. First of all, dont put the read-line function inside the while loop.Read and parse the text file once to create a list Where laylst is the data from reading and parsing the file Lets say you have the layer ELECTRICAL 7 HIDDEN (defun c:moore (/ _match laylst a coll tlst) [b][color=blue](defun _match (nm col lt lst / n f)[/color][/b] [b][color=blue] (while (and (setq n (car lst)) (not f))[/color][/b] [b][color=blue] (if (and[/color][/b] [b][color=blue] (wcmatch (strcase nm) (strcat (car n) "*"))[/color][/b] [b][color=blue] (eq col (cadr n))[/color][/b] [b][color=blue] (eq (strcase lt) (last n)))[/color][/b] [b][color=blue] (setq f T)[/color][/b] [b][color=blue] (setq lst (cdr lst)))) (car n))[/color][/b] (vl-load-com) (setq acadDocument (vla-get-activedocument (vlax-get-acad-object))) (setq layertable (vla-get-layers acadDocument)) [color=olive];;; example Result from a parsing routine ;;;[/color] [color=olive](setq laylst '(("CPRT" 4 "CONTINUOUS") ("CPRT" 7 "CONTINUOUS")[/color] [color=olive] ("CUTLINE" 5 "HIDDEN") ("CUTLINE" 7 "HIDDEN")[/color] [color=olive] ("DASHED" 2 "DASHED") ("DASHED" 2 "PHANTOM")[/color] [color=olive] ("DASHED" 7 "PHANTOM") ("DEFPOINTS" 7 "CONTINUOUS")[/color] [color=olive] ("DEPT" 3 "CONTINUOUS") ("DEPT" 7 "CONTINUOUS")[/color] [color=olive] ("DIM" 2 "CONTINUOUS") ("DIM" 7 "CONTINUOUS")[/color] [color=olive] ("DIMN" 1 "CONTINUOUS") ("DIMN" 7 "CONTINUOUS")[/color] [color=olive] ("ELEC" 1 "HIDDEN") ("ELEC" 7 "HIDDEN")))[/color] (while (setq a (tblnext "LAYER" (null a))) (setq coll (list (cdr (assoc 2 a)) (cdr (assoc 62 a)) (cdr (assoc 6 a)))) (if (and (setq tlst (vl-remove-if-not '(lambda (ly) (eq (strcase (substr (car ly) 1 1)) (strcase (substr (car coll) 1 1)))) laylst)) (setq newname (_match (car coll)(cadr coll)(last coll) tlst)) ) (vla-put-name (vla-item layertable (car coll)) newname)) ) ) It reduces the list per loop depending on the first character of the layername Then use _match routine for "comparison" test if found returens the New Layer Name HTH BTW: what i meant by this ELECTRICAL/1/HIDDEN will be ELEC, and ELECTRICAL/7/HIDDEN will also be ELEC, is that right? is it one or the other? because you have two lines ELEC 1 HIDDEN ELEC 7 HIDDEN included on the text file. Quote Link to comment Share on other sites More sharing options...
btraemoore Posted April 30, 2012 Author Share Posted April 30, 2012 im having a hard time understanding what you did with the _match, after did you basically compare everything at the same time? Quote Link to comment Share on other sites More sharing options...
btraemoore Posted April 30, 2012 Author Share Posted April 30, 2012 This is where I'm at so far, now i am going to try to use the wcmatch to narrow down my name selection (defun fixlay (/) (vl-load-com) (setq acadDocument (vla-get-activedocument (vlax-get-acad-object))) (setq layertable (vla-get-layers acadDocument)) (setq f (open "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt" "r")) (while (setq Lay (tblnext "LAYER" 1)) (setq oldlayLT (cdr (assoc 6 lay)) oldlayCOLOR (itoa (cdr (assoc 62 lay))) oldlayNM (cdr (assoc 2 lay)) oldcompLST (list laycolor laylt)) (while (/= dataline1 "eof") (setq dataline (read-line f) k 1 a "" LST nil) (repeat (strlen dataline1) (if (= (substr dataline k 1) "\t") (progn (setq LST (append LST (list a))) (setq a "") );progn (setq a (strcat a (substr dataline k 1))) );if (setq k (+ k 1)) );repeat (setq LST (append LST (list a))) (setq newlayNM (car (cdr (cons 1 LST))) newcompLST (cdr (cdr (cons 1 LST))) newlayLT (cdr (cdr LST)) newlayCOLOR (atoi (car (cdr lst)))) (if (/= newlayNM oldlayNM) (progn (if (and (= (nth 1 oldcompLST)(nth 1 newcompLST))(= (nth 2 oldcompLST)(nth 2 newcompLST))) (setq newlayNMLST (append newlayNMLST (list newlayNM))) );if );progn (if (/= oldlayLT newlayLT) (vlax-put-property LAY 'Linetype newlayLT));if (if (/= oldlayCOLOR newlayCOLOR) (vlax-put-property LAY 'Color newlayCOLOR) );if );if );while );while Quote Link to comment Share on other sites More sharing options...
pBe Posted May 1, 2012 Share Posted May 1, 2012 The second line is the new Nane, Linetype and Color. So its not jsut the name but also the lt and color CLINE 7 CENTER CLINES 7 CENTER2 Load layers (revert to original state) and Transalte (This name to that) at the same time. I've seen a lot Layer routine out there, but this one takes the cake I can modify the code i posted to do just that. I'll look into it later. Quote Link to comment Share on other sites More sharing options...
btraemoore Posted May 1, 2012 Author Share Posted May 1, 2012 hey, good morning. alright, so i tried to read the code this morning and i cant seem to understand what it is doing. I mean i get that it fixes it, but i guess i dont understand the coding for the _match, if you could comment it out for me so i can learn from it that would be awesome edit: its very important that i learn from it, especially when i have no one to teach me. Im only about a month in to coding... Quote Link to comment Share on other sites More sharing options...
pBe Posted May 1, 2012 Share Posted May 1, 2012 Good for you btraemoore. Should we proceed with that approach? If YES, i still need to modify _Match sub-routine Would you like maintain the sequence the way your code is written? Am i correct in my assumption on the previous post? CLINE 7 CENTER Would you want to replace your code the way the file is read and stored on a list? On another note. Hang around and read the posts on this forum, You'll be amaze how one task can be coded in so many different ways. On my part i'm still a novice and still have much to learn. Quote Link to comment Share on other sites More sharing options...
btraemoore Posted May 1, 2012 Author Share Posted May 1, 2012 CLINE 7 CENTER yes this is ultimately what i am trying to do, i guess i prefer the syntax the way i write because its easier for me to read and to learn from. I am still playing around with the code that i wrote... soooo many bugs i keep getting a stringp nil error... im guessing its because its not moving to the next layer in the table... visual lisp is extremely new for me, but yes you have the right idea of what i want to do with this routine. Thank you very much for your help Quote Link to comment Share on other sites More sharing options...
btraemoore Posted May 1, 2012 Author Share Posted May 1, 2012 so, this is where i am at. I'm not getting any errors, but its not reading past the first layer (defun C:flay () (vl-load-com) (setq acadDocument (vla-get-activedocument (vlax-get-acad-object))) (setq layertable (vla-get-layers acadDocument)) (setq f (open "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt" "r")) (setq Lay (tblnext "LAYER" 1)) (setq count 0) (setq mcnt 0) (repeat laycnt (setq oldlayLT (cdr (assoc 6 lay)) oldlayCOLOR (itoa (cdr (assoc 62 lay))) oldlayNM (cdr (assoc 2 lay)) oldcompLST (list oldlayCOLOR oldlayLT) dataline (read-line f)) (while (/= dataline nil) (setq k 1 a "" LST nil) (repeat (strlen dataline) (if (= (substr dataline k 1) "\t") (progn (setq LST (append LST (list a))) (setq a "") ) (setq a (strcat a (substr dataline k 1))) ) (setq k (+ k 1)) ) (setq LST (append LST (list a))) (setq mlst (append mlst (list lst))) (setq newlayNM (car (cdr (cons 1 LST))) newcompLST (cdr (cdr (cons 1 LST))) newlayLT (cdr (cdr LST)) newlayCOLOR (car (cdr lst))) (if (= newlaynm oldlaynm) (progn (setq count (+ 1 count)) (if (and (= oldlaycolor newlaycolor)(= oldlaylt newlaylt)) (progn (setq newlayNMLST (append newlayNMLST (list newlayNM))) ) ) ) (setq match (append match (list oldlaynm)) mcnt (+ mcnt 1));;; just a test ) (princ oldlaynm)(princ " ");;;another test (setq dataline (read-line f)) ) )(setq Lay (tblnext "LAYER")) ) (defun c:Lcnt() (setq acadDocument (vla-get-activedocument (vlax-get-acad-object))) (setq layertable (vla-get-layers acadDocument)) (setq Lay (tblnext "LAYER" 1)) (while lay (setq oldlayNM (cdr (assoc 2 lay))) (setq laycnt (append laycnt (list oldlaynm))) (setq lay (tblnext "layer")) ) (setq laycnt (length laycnt)) ) (defun c:fixlay(/ laycnt) (command "-purge" "a" "" "n") (c:lcnt) (c:flay) );defun this is what i get in my command box after running the routine. Command: 0 BORDER ELEC MATCH POWER SYMBOLS TEXT UTIL BALLOON nil Command: !match ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0") any suggestions? Quote Link to comment Share on other sites More sharing options...
pBe Posted May 2, 2012 Share Posted May 2, 2012 (edited) so, this is where i am at. I'm not getting any errors, but its not reading past the first layer any suggestions? (= newlaynm oldlaynm) evaluates to nil as variable LAY remains as "0" thru the entire repeat/loop [Hence you get this -> ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" ....)] because you had this (setq Lay (tblnext "LAYER")) outside repeat. I wouldsuggest you use (wcmatch oldlaynm (strcat newlaynm "*")) Anyhoo, thats sut one of the "bugs" btraemoore. For now have a look-see at this code (defun c:moore (/ _match _delFinder _entmod laylst f a laylst coll newname Thislayer) (vl-load-com) (defun _match (nm col lt lst / n fn) (while (and (setq n (car lst)) (not fn)) (if (and (wcmatch (strcase nm) (strcat (car n) "*")) (= col (atoi (cadr n))) (eq (strcase lt) (last n))) (setq fn [b][color=blue](cadr lst)[/color][/b]) (setq lst [b][color=blue](cddr lst)[/color][/b]))) fn) (defun _delFinder (str md / d l str) (while (setq d (vl-string-position md str nil T)) (setq l (cons (substr str (+ 2 d)) l) str (substr str 1 d))) (cons str l) ) (setq _entmod (lambda (v dx entg) (entmod (subst (cons dx v)(assoc dx entg) entg)))) (if (setq laylst nil f (findfile "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt")) (progn (setq f (open f "r")) (while (setq a (read-line f)) (setq laylst (cons (_delFinder a 32) laylst)) ) (setq laylst (reverse laylst)) (close f) (while (setq a (tblnext "LAYER" (null a))) (cond ((and (not (member (setq lyn (cdr (assoc 2 a))) '("DEFPOINTS" "0"))) (setq coll (list lyn (cdr (assoc 62 a))(cdr (assoc 6 a)))) (setq newname (_match lyn (cadr coll)(last coll) laylst)) (setq Thislayer (entget (tblobjname "LAYER" lyn)) Thislayer [b][color=blue](if (not (tblsearch "LAYER" (car newname))) (_entmod (car newname) 2 Thislayer) Thislayer) [/color][/b] Thislayer (_entmod (atoi (cadr newname)) 62 Thislayer) Thislayer (_entmod (caddr newname) 6 Thislayer)) ))) ) ) )(princ) ) I tried to write it without Vlisp (execpt vl-string-position : run out of time) Also i notice you have "0" include on the list and "2" right after that. You cannot rename layer "0" Tell me what part you dont undertstand, then i'll put a comment on those parts. HTH CODE UPDATED: Remove function for reduce list Remove m variable Allow a totally different name if the 1st lien is a match If new layer name exist change the Color and/or Linetype. Edited May 3, 2012 by pBe Update Code Quote Link to comment Share on other sites More sharing options...
btraemoore Posted May 2, 2012 Author Share Posted May 2, 2012 (defun c:moore (/ _match _delFinder _entmod laylst f a laylst coll tlst newname Thislayer) (vl-load-com) (defun _match (nm col lt lst / n fn) (while (and (setq n (car lst)) [color="red"](not fn)[/color]) (if (and (setq m (cdr lst)) (wcmatch (strcase nm) (strcat (car n) "*")) (= col (atoi (cadr n))) (eq (strcase lt) [color="red"](last n)[/color]) (eq (car n)[color="red"](caar m)[/color])) (setq fn (car m)) (setq lst (cdr m)))) fn) (defun _delFinder (str md / d l str) (while (setq d (vl-string-position md str nil T)) (setq l (cons (substr str (+ 2 d)) l) str (substr str 1 d))) (cons str l) ) (setq _entmod ([color="red"]lambda[/color] (v dx entg) (entmod (subst (cons dx v)(assoc dx entg) entg)))) (if (setq laylst nil f (findfile "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt")) (progn (setq f (open f "r")) (while (setq a (read-line f)) (setq laylst (cons (_delFinder a 32) laylst)) ) (setq laylst (reverse laylst)) (close f) (while (setq a (tblnext "LAYER" (null a))) (cond ((and (not (member (setq lyn (cdr (assoc 2 a))) '("DEFPOINTS" "0"))) (setq coll (list lyn (cdr (assoc 62 a))(cdr (assoc 6 a)))) (setq tlst (vl-remove-if-not '(lambda (ly) (if (numberp (read lyn)) (wcmatch (car ly) "#*") (eq (strcase (substr (car ly) 1 1)) (strcase (substr lyn 1 1))))) laylst)) (setq newname (_match lyn (cadr coll)(last coll) tlst)) (not (tblsearch "LAYER" (car newname))) (setq Thislayer (entget (tblobjname "LAYER" lyn)) Thislayer (_entmod (car newname) 2 Thislayer) Thislayer (_entmod (atoi (cadr newname)) 62 Thislayer) Thislayer (_entmod (caddr newname) 6 Thislayer)) ))) ) ) )(princ) ) ) the parts in red are the parts that i dont understand, but in a basic overview if you could just put a few comments after the major functions so i can grasp how the code works that would be amazing. Quote Link to comment Share on other sites More sharing options...
pBe Posted May 2, 2012 Share Posted May 2, 2012 (edited) (defun _match (nm col lt lst / n fn) (while (and (setq n (car lst)) [b][color=sienna](not fn)[/color][/b]) [b][color=blue];; While the variable fn is nil the expression will evaluate to T [/color][/b] [b][color=blue];; as well as variable n is not nil [/color][/b] (if (and (setq m (cdr lst)) (wcmatch (strcase nm) (strcat (car n) "*")) (= col (atoi (cadr n))) (eq (strcase lt) [b][color=sienna](last n)[/color][/b]) [color=blue][b];; if varialbe n is T it will be a 3 element list [/b][/color] [color=blue][b];; say value for n is ("ELEC" 1 "HIDDEN") last of n is "HIDDEN" [/b][/color] (eq (car n)[b][color=sienna](caar m)[/color][/b])) [b][color=blue];; if variable m is not nil it will be the rest of the variable lst[/color][/b] [b][color=blue];; in this case lst is the reduce list of the generated list [/color][/b] [b][color=blue];; from the text file. say ((ELEC 1 "HiDDEN")("ELEC" 7 "HIDDEM")) [/color][/b] [b][color=blue];; (caar is the first element of the first element of the list [/color][/b] [b][color=blue];; similar to (Car (car lst))[/color][/b] (setq fn (car m)) (setq lst (cdr m)))) fn) for lambda http://www.cadtutor.net/forum/showthread.php?52127-Mapcar-lambda-Description Did the routine work for you? Edited May 2, 2012 by pBe Quote Link to comment Share on other sites More sharing options...
btraemoore Posted May 2, 2012 Author Share Posted May 2, 2012 I changed a few layer names and layer colors in the current drawing that im in and ran it, it didn't error out but it also didn't change anything. Quote Link to comment Share on other sites More sharing options...
pBe Posted May 2, 2012 Share Posted May 2, 2012 (edited) I changed a few layer names and layer colors in the current drawing that im in and ran it, it didn't error out but it also didn't change anything. Well, there's not much i can do about that now. Unless i have a copy of the files you are using (TXT/DWG). Otherwise it will all guess work from hereon. Come to think of it, its been like that form the start . Here are the conditions: *The data from the text file should be like this: ELEC 1 HIDDEN use for comparison and ELEC 7 HIDDEN for new values. if the layer names doesnt match, the _match function will evaluate to nil, unless that is your intention all along. *The Layer already exists. we cant have two similar names on the Layer collection It WOULD work in these cases Elecrical 1 HIDDEN to ELEC 7 HiDDEN Dimension 2 Continuous to DIM 4 DASHED granting the text file format is ELEC 1 HIDDEN ELEC 7 HIDDEN DIM 2 CONTINUOUS DIM 4 DASHED You see now? as long the the first line is a match wcmatch DIMENSION DIM* 2 - 2 HIDDEN - HIDDEN Only then it will rename the Layer name But it wont change if DIM 3 HIDDEN DIM 4 DASHED as 3 is not a match. The important thing there is the 1st of the pair (the comparison line) Now if you need the 2nd line of the pair as deifferent name. it can still be done. but i need to see the bigger picture. ---- >> pBe Edited May 2, 2012 by pBe Quote Link to comment Share on other sites More sharing options...
btraemoore Posted May 2, 2012 Author Share Posted May 2, 2012 Well, there's not much i can do about that now. Unless i have a copy of the files you are using (TXT/DWG). Otherwise it will all guess work from hereon. Come to think of it, its been like that form the start . Here are the conditions: *The data from the text file should be like this: ELEC 1 HIDDEN use for comparison and ELEC 7 HIDDEN for new values. if the layer names doesnt match, the _match function will evaluate to nil, unless that is your intention all along. *The Layer already exists. we cant have two similar names on the Layer collection It WOULD work in these cases Elecrical 1 HIDDEN to ELEC 7 HiDDEN Dimension 2 Continuous to DIM 4 DASHED granting the text file format is ELEC 1 HIDDEN ELEC 7 HIDDEN DIM 2 CONTINUOUS DIM 4 DASHED You see now? as long the the first line is a match wcmatch DIMENSION DIM* 2 - 2 HIDDEN - HIDDEN Only then it will rename the Layer name But it wont change if DIM 3 HIDDEN DIM 4 DASHED as 3 is not a match. The important thing there is the 1st of the pair (the comparison line) Now if you need the 2nd line of the pair as deifferent name. it can still be done. but i need to see the bigger picture. ---- >> pBe LOL, thanks for all your help, bro. im going to take a break from it for a bit, and it seems that you need to... ill come back to it in a few days... give my self time to rethink what im doing and what i want my ultimate goal to be... Thanks again for the lessons.. Quote Link to comment Share on other sites More sharing options...
pBe Posted May 3, 2012 Share Posted May 3, 2012 [/color][/b][b][color=#0000ff][/color][/b] [color=black]To work with this conditions:[/color][b]CLINE 7 CENTER : [color=black]CLINE 7 CENTER ;[b]CLINES[/b] 7 [b]CENTER2[/b] ;[color=black] [b]COLUMN 1 CONTINUOUS : COL 1 CONTINUOUS ;[b]CONC[/b] 1 [b]HIDDEN[/b] ; [b]CUTLINE 5 HIDDEN[/b] [b]: CUTLINE 5 HIDDEN ;CUTLINE [b]7 [/b]HIDDEN ; Quote Link to comment Share on other sites More sharing options...
btraemoore Posted May 3, 2012 Author Share Posted May 3, 2012 I started over yesterday and came up with this, im still thinking about how i want it to work for the names, could i implement _match in here some how? and i fixed the format of the .txt, to not be able to have everything in white... so there is only 1 selection for each name.. (defun C:flay (/ layerTable standardList currentLayer currentCompare) (vl-load-com) (setq layerTable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) (setq standardList (readTxt "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt")) (setq layerCount 0) (repeat (vla-get-count layerTable) (setq currentLayer (vla-item layerTable layerCount)) (setq old_layername (vla-get-name currentLayer) old_color (vla-get-color (itoa currentLayer)) old_linetype (vla-get-linetype currentLayer) old_layerData (list old_layername old_color old_linetype) );setq (setq compareCount 0) (while (/= compareCount (length standardList)) (setq currentCompare (splitstr (nth compareCount standardList) "\t")) (setq compare_layername (car currentCompare) compare_color (cadr currentCompare) compare_linetype (caddr currentCompare) );setq (if (= old_layername compare_layername) (progn (vla-put-color currentLayer (atoi compare_color)) (vla-put-linetype currentlayer compare_linetype) );progn );if (setq compareCount (+ compareCount 1)) (setq currentCompare nil compare_layername nil compare_color nil compare_linetype nil) );while (setq compareCount nil) (setq layerCount (+ layerCount 1)) )(princ "changed ")(princ layercount)(princ " layers") ) (defun readTxt(txtFile / dataList line) (setq f (open txtFile "r")) (setq dataList '()) (while (setq line (read-line f)) (setq dataList (cons line dataList)) );while (close f) (setq dataList (reverse dataList)) );defun (defun splitstr (str delim / ptr lst) (while (setq ptr (vl-string-search delim str)) (setq lst (cons (substr str 1 ptr) lst)) (setq str (substr str (+ ptr 2))) ) (reverse (cons str lst)) ); splitstr Quote Link to comment Share on other sites More sharing options...
btraemoore Posted May 7, 2012 Author Share Posted May 7, 2012 Finally got it done (defun C:flay (/ new_nameList layerTable standardList currentLayer currentCompare nilList compare_layerdata nil_layername nil_color nil_linetype layerlist pos new_namelist ) (vl-load-com) (setq layerTable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) standardList (readTxt "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt") layerCount 0 );setq (repeat (vla-get-count layerTable) (setq currentLayer (vla-item layerTable layerCount)) (setq old_layername (vla-get-name currentLayer) old_color (vla-get-color currentLayer) old_linetype (vla-get-linetype currentLayer) old_layerData (list old_layername old_color old_linetype) compareCount 0 existsflag nil );setq (setq layerlist (append layerlist (list old_layername))) (while (and (/= compareCount (length standardList))(/= existsflag T)) (setq currentCompare (splitstr (nth compareCount standardList) "\t")) (setq compare_layername (car currentCompare) compare_color (cadr currentCompare) compare_linetype (caddr currentCompare) );setq (if (= old_layername "0") (setq existsflag T) (progn (if (= old_layername compare_layername) (progn (vla-put-color currentLayer (atoi compare_color)) (vla-put-linetype currentlayer compare_linetype) (vl-remove (nth compareCount standardList) standardList) (setq existsflag T compareCount (- 1 compareCount) );setq );progn );if );progn );if (setq compareCount (+ compareCount 1) currentCompare nil compare_layername nil compare_color nil compare_linetype nil );setq );while (if (= existsflag nil) (setq nilList (append nilList (list old_layerData))) );if (setq compareCount nil layerCount (+ layerCount 1) );setq );repeat (if (/= nullist nil) (progn (princ "layer/layers ")(princ nillist)(princ " are not standard") );progn );if (setq layerCount 0) (repeat (length nilList) (setq currentLayer (nth layerCount nilList)) (setq nil_layername (car currentLayer) nil_color (cadr currentLayer) nil_linetype (strcase (caddr currentLayer)) compareCount 0 existsflag nil );setq (while (and (/= compareCount (length standardList))(/= existsflag T)) (setq currentCompare (splitstr (nth compareCount standardList) "\t")) (setq compare_layername (car currentCompare) compare_color (cadr currentCompare) compare_linetype (strcase (caddr currentCompare)) compare_layerData (list compare_layername compare_color compare_linetype) );setq (if (= (atoi compare_color) nil_color) (progn (if (= compare_linetype nil_linetype) (progn (setq pos (vl-position compare_layername layerlist)) (if (= pos nil) (progn (command "-rename" "la" nil_layername compare_layername) (setq layerlist (append layerlist (list compare_layername))) (vl-remove (nth compareCount standardList) standardList) (setq existsflag T compareCount (- 1 compareCount) new_namelist (append new_namelist (list compare_layerdata)) );setq );progn );if );progn );if );progn );if (setq compareCount (+ compareCount 1) currentCompare nil compare_layername nil compare_color nil compare_linetype nil );setq );while (setq compareCount nil layerCount (+ layerCount 1) );setq )(princ "changed ")(princ nilList) (princ " to ")(princ new_nameList) ) (defun readTxt(txtFile / dataList line) (setq f (open txtFile "r")) (setq dataList '()) (while (setq line (read-line f)) (setq dataList (cons line dataList)) );while (close f) (setq dataList (reverse dataList)) );defun (defun splitstr (str delim / ptr lst) (while (setq ptr (vl-string-search delim str)) (setq lst (cons (substr str 1 ptr) lst)) (setq str (substr str (+ ptr 2))) ) (reverse (cons str lst)) ); splitstr (defun c:fixlay() (command "-purge" "a" "" "n") (c:flay) );defun (c:fixlay) Quote Link to comment Share on other sites More sharing options...
pBe Posted May 7, 2012 Share Posted May 7, 2012 Finally got it done ;;;;;;;;;;;;;;;; ---> [/b];;btraemoore;; Good for you. Quote Link to comment Share on other sites More sharing options...
btraemoore Posted May 7, 2012 Author Share Posted May 7, 2012 (edited) lol... well now im doing one for text styles.... im trying to figure out this error, in vlide im getting a warning "warning: redefinition of built-in symbol: VL-LOAD-COM". it also gives me to few arguments error.. ive never seen the warning before, and especially for vl-load-com you have any ideas? (defun C:fixsty() (vl-load-com) (setq StyleTable (vla-get-textStyles (vla-get-activedocument (vlax-get-acad-object))) standardList (readTxt "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardStyles.txt") StyleCount 0 );setq (repeat (vla-get-count StyleTable) (setq currentStyle (vla-item StyleTable StyleCount)) (setq old_Stylename (vla-get-name currentStyle) old_Font (vla-get-FontFile currentStyle) compareCount 0 existsflag nil );setq (setq Stylelist (append Stylelist (list old_Stylename))) (while (and (/= compareCount (length standardList))(/= existsflag T)) (setq currentCompare (splitstr (nth compareCount standardList) "\t")) (setq compare_Stylename (car currentCompare) compare_font (cadr currentCompare) );setq (if (= old_Stylename compare_Stylename) (progn (vla-put-fontfile currentStyle compare_font) (vl-remove (nth compareCount standardList) standardList) (setq existsflag T compareCount (- 1 compareCount) );setq );progn );if (setq compareCount (+ compareCount 1) currentCompare nil compare_Stylename nil compare_color nil compare_linetype nil );setq );while (if (= existsflag nil) (setq nilList (append nilList (list old_Stylename))) );if (setq compareCount nil StyleCount (+ StyleCount 1) );setq );repeat (if (/= nullist nil) (progn (princ "Style/Styles ")(princ nillist)(princ " are not standard") );progn );if );defun disregard i left ( ) out after defun... im an idiot Edited May 7, 2012 by btraemoore 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.