Artek Posted August 17, 2013 Posted August 17, 2013 I'm looking for a lisp program that can fix the layer names for the following conditions: 1. List of specific words like wall, col, first, second, etc. to be all in capital letters. This only happens when the layer name has a number prefix like "1-WALL-cavity". 2. Every first letter and succeeding first letters after a hyphen. 3. Change any symbol in between words to a hyphen like "_" to "-". Or add the hyphen in between words if it's missing. 4. Only if it's possible but not necessary. To make every word singular in form like walls to wall, plans to plan, elevations to elevation etc. We're getting different versions of layer names from different drawings and this needs to be tidied up as well. I tried laytrans but turned out to be a nightmare because they're just too many of them and very random in most cases. 0-wall-insulation to 0-WALL-Insulation Wall-cavities to Wall-Cavities or Wall-Cavity (if possible ) 1-first-columns to 1-FIRST-Column 0-col-round to 0-COL-Round Grid_lines to Grid-Lines or Grid-Line (without the s if possible) Hatch plans main to Hatch-Plans-Main or Hatch-Plan-Main (without the s if possible) I know it's a bit unusual but that's a cad standard that I need to meet and I have gazillion of layers to tidy up. Thank you. Quote
hmsilva Posted August 17, 2013 Posted August 17, 2013 One way... is a bit hard-coded, but I think it does the trick. At the old-lst, you have to put the character set you want to be replaced, and at the new-lst, the new character set, remember that the number of elements in both lists must be the same, and that the first element of the first list will be replaced by the first element of the second list, the second, by the second and so on. (defun c:test (/ L LAYN NEW-LST OLD-LST) (setq old-lst '("_" "wall" "col" "first" "second" "insulation" "cavity" "cavities" "lines")) (setq new-lst '("-" "WALL" "COLL" "FIRST" "SECOND" "Insulation" "Cavity" "Cavity" "Line")) (vlax-for lay (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)) ) (if (wcmatch (setq layn (vla-get-Name lay)) "#_*,#-*") (progn (setq l (length old-lst)) (while (not (minusp (setq l (1- l)))) (while (vl-string-search (nth l old-lst) layn) (setq layn (vl-string-subst (nth l new-lst) (nth l old-lst) layn)) );; while );; while (vla-put-Name lay layn) );; progn );; if );; vlax-for );; test HTH Henrique Quote
Lee Mac Posted August 17, 2013 Posted August 17, 2013 Consider the following program, the command is fixlayers: ([color=BLUE]defun[/color] c:fixlayers ( ) ([color=BLUE]vlax-for[/color] lay ([color=BLUE]vla-get-layers[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))) ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-put-name[/color] ([color=BLUE]list[/color] lay (processlayer ([color=BLUE]vla-get-name[/color] lay)))) ) ([color=BLUE]princ[/color]) ) ([color=BLUE]defun[/color] processlayer ( str ) ( ([color=BLUE]lambda[/color] ( lst ) ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]cadr[/color] lst) ([color=BLUE]wcmatch[/color] ([color=BLUE]car[/color] lst) [color=MAROON]"~*[~0-9]*"[/color])) ([color=BLUE]setq[/color] lst ([color=BLUE]vl-list*[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]strcase[/color] ([color=BLUE]cadr[/color] lst)) ([color=BLUE]cddr[/color] lst))) ) ([color=BLUE]substr[/color] ([color=BLUE]apply[/color] '[color=BLUE]strcat[/color] ([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( x ) ([color=BLUE]strcat[/color] [color=MAROON]"-"[/color] ([color=BLUE]strcase[/color] ([color=BLUE]substr[/color] x 1 1)) ([color=BLUE]cond[/color] ( ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] x) [color=MAROON]"*IES"[/color]) ([color=BLUE]strcat[/color] ([color=BLUE]substr[/color] x 2 ([color=BLUE]-[/color] ([color=BLUE]strlen[/color] x) 4)) ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"S"[/color] ([color=BLUE]substr[/color] x ([color=BLUE]strlen[/color] x))) [color=MAROON]"Y"[/color] [color=MAROON]"y"[/color])) ) ( ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] x) [color=MAROON]"*S"[/color]) ([color=BLUE]substr[/color] x 2 ([color=BLUE]-[/color] ([color=BLUE]strlen[/color] x) 2)) ) ( ([color=BLUE]substr[/color] x 2)) ) ) ) ) lst ) ) 2 ) ) (LM:mparse str '([color=MAROON]" "[/color] [color=MAROON]"_"[/color] [color=MAROON]"-"[/color])) ) ) [color=GREEN];; Multi-delimiter Parse - Lee Mac[/color] [color=GREEN];; Separates a string using a list of delimiters[/color] [color=GREEN];; str - [str] string to process[/color] [color=GREEN];; lst - [lst] list of delimiter strings[/color] ([color=BLUE]defun[/color] LM:mparse ( str lst ) ([color=BLUE]if[/color] ([color=BLUE]cdr[/color] lst) ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) (LM:mparse x ([color=BLUE]cdr[/color] lst))) (LM:parse str ([color=BLUE]car[/color] lst)))) (LM:parse str ([color=BLUE]car[/color] lst)) ) ) [color=GREEN];; Parse - Lee Mac[/color] [color=GREEN];; Separates a string using a given delimiter[/color] [color=GREEN];; str - [str] string to process[/color] [color=GREEN];; del - [str] delimiter by which to separate the string[/color] ([color=BLUE]defun[/color] LM:parse ( str del [color=BLUE]/[/color] pos ) ([color=BLUE]if[/color] ([color=BLUE]setq[/color] pos ([color=BLUE]vl-string-search[/color] del str)) ([color=BLUE]vl-remove[/color] [color=MAROON]""[/color] ([color=BLUE]cons[/color] ([color=BLUE]substr[/color] str 1 pos) (LM:parse ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] 1 pos ([color=BLUE]strlen[/color] del))) del))) ([color=BLUE]list[/color] str) ) ) ([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color]) Example of output from processlayer function: _$ (processlayer "Wall-cavities") "Wall-Cavity" _$ (processlayer "1-first-columns") "1-FIRST-Column" _$ (processlayer "Grid_lines") "Grid-Line" Assumptions: Existing layer name sections are separated by either a hyphen, underscore or space character (other delimiters may be incorporated if necessary). Strings ending 'ies' are to be replaced with 'y', e.g. "cavities" => "cavity" Strings ending 's' should have this character removed, e.g. "plans" => "plan" Layers with a numerical prefix should have the second element capitalised, e.g. "10-abc-layer" => "10-ABC-Layer" All items should have an uppercase first letter. Quote
Artek Posted August 18, 2013 Author Posted August 18, 2013 (edited) I can't thank you both enough for your brilliant codes. Many thanks to Henrique for his quick, short but effective fix to some of my conditions. Lee's on the other hand never ceases to amaze me with his codes. You nailed it once again! I can't even imagine how you've done it. Just one more thing before I let you go Lee - if you don't mind . Is there any chance you can include something like an exemption list for those strings ending in "s" to be removed please? Apologies for realizing this just now. I forgot about those layers names that are plural by default and also those words ending in "s" like Defpoints, Recess, etc. Silly me... Sorry to be a pain. I'm just thinking that we can generalize it this way. Aside from the exemption list for Defpoints, Access, Recess etc., can we also just skip the layer names beginning with number/s (0-WALLS...)? I noticed on most drawings, the inconsistencies only happen on layers with non-standard names or those without the number headings. The layering really is a bit messy because the drawing is actually an amalgamation of multiple layouts from different contractors who sometimes don't bother to comply with standards. Anyways, many, many thanks, Lee. Example: 3-wall-insulations to 3-WALL-Insulations Walls-insulation to Wall-Insulation Access-hatch to Access-Hatch (not Acces-Hatch) Defpoints to Defpoints (not Defpoint) Recess-wall to Recess-Wall (not Reces-Wall) Edited August 18, 2013 by Artek Additional condition and explanation Quote
Lee Mac Posted August 18, 2013 Posted August 18, 2013 Nice code, Lee! Many thanks indeed Henrique! I can't thank you both enough for your brilliant codes. Many thanks to Henrique for his quick, short but effective fix to some of my conditions. Lee's on the other hand never ceases to amaze me with his codes. You nailed it once again! I can't even imagine how you've done it. Thank you very much for your compliments Artek - the program was interesting & enjoyable to write Is there any chance you can include something like an exemption list for those strings ending in "s" to be removed please? Apologies for realizing this just now. I forgot about those layers names that are plural by default and also those words ending in "s" like Defpoints, Recess, etc. Silly me... No problem - the following modified code should handle these cases as shown by the output below: ([color=BLUE]defun[/color] c:fixlayers ( ) ([color=BLUE]vlax-for[/color] lay ([color=BLUE]vla-get-layers[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))) ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-put-name[/color] ([color=BLUE]list[/color] lay (processlayer ([color=BLUE]vla-get-name[/color] lay)))) ) ([color=BLUE]princ[/color]) ) ([color=BLUE]defun[/color] processlayer ( str ) ( ([color=BLUE]lambda[/color] ( lst [color=BLUE]/[/color] flg ) ([color=BLUE]if[/color] ([color=BLUE]setq[/color] flg ([color=BLUE]and[/color] ([color=BLUE]cadr[/color] lst) ([color=BLUE]wcmatch[/color] ([color=BLUE]car[/color] lst) [color=MAROON]"~*[~0-9]*"[/color]))) ([color=BLUE]setq[/color] lst ([color=BLUE]vl-list*[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]strcase[/color] ([color=BLUE]cadr[/color] lst)) ([color=BLUE]cddr[/color] lst))) ) ([color=BLUE]substr[/color] ([color=BLUE]apply[/color] '[color=BLUE]strcat[/color] ([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( x [color=BLUE]/[/color] y ) ([color=BLUE]setq[/color] y ([color=BLUE]strcase[/color] x)) ([color=BLUE]strcat[/color] [color=MAROON]"-"[/color] ([color=BLUE]strcase[/color] ([color=BLUE]substr[/color] x 1 1)) ([color=BLUE]cond[/color] ( ([color=BLUE]or[/color] flg ([color=BLUE]=[/color] y [color=MAROON]"DEFPOINTS"[/color])) ([color=BLUE]substr[/color] x 2) ) ( ([color=BLUE]wcmatch[/color] y [color=MAROON]"*IES"[/color]) ([color=BLUE]strcat[/color] ([color=BLUE]substr[/color] x 2 ([color=BLUE]-[/color] ([color=BLUE]strlen[/color] x) 4)) ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"S"[/color] ([color=BLUE]substr[/color] x ([color=BLUE]strlen[/color] x))) [color=MAROON]"Y"[/color] [color=MAROON]"y"[/color])) ) ( ([color=BLUE]wcmatch[/color] y [color=MAROON]"*[~S]S"[/color]) ([color=BLUE]substr[/color] x 2 ([color=BLUE]-[/color] ([color=BLUE]strlen[/color] x) 2)) ) ( ([color=BLUE]substr[/color] x 2)) ) ) ) ) lst ) ) 2 ) ) (LM:mparse str '([color=MAROON]" "[/color] [color=MAROON]"_"[/color] [color=MAROON]"-"[/color])) ) ) [color=GREEN];; Multi-delimiter Parse - Lee Mac[/color] [color=GREEN];; Separates a string using a list of delimiters[/color] [color=GREEN];; str - [str] string to process[/color] [color=GREEN];; lst - [lst] list of delimiter strings[/color] ([color=BLUE]defun[/color] LM:mparse ( str lst ) ([color=BLUE]if[/color] ([color=BLUE]cdr[/color] lst) ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) (LM:mparse x ([color=BLUE]cdr[/color] lst))) (LM:parse str ([color=BLUE]car[/color] lst)))) (LM:parse str ([color=BLUE]car[/color] lst)) ) ) [color=GREEN];; Parse - Lee Mac[/color] [color=GREEN];; Separates a string using a given delimiter[/color] [color=GREEN];; str - [str] string to process[/color] [color=GREEN];; del - [str] delimiter by which to separate the string[/color] ([color=BLUE]defun[/color] LM:parse ( str del [color=BLUE]/[/color] pos ) ([color=BLUE]if[/color] ([color=BLUE]setq[/color] pos ([color=BLUE]vl-string-search[/color] del str)) ([color=BLUE]vl-remove[/color] [color=MAROON]""[/color] ([color=BLUE]cons[/color] ([color=BLUE]substr[/color] str 1 pos) (LM:parse ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] 1 pos ([color=BLUE]strlen[/color] del))) del))) ([color=BLUE]list[/color] str) ) ) ([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color]) Example of output from processlayer function: _$ (processlayer "3-wall-insulations") "3-WALL-Insulations" _$ (processlayer "Walls-insulation") "Wall-Insulation" _$ (processlayer "Access-hatch") "Access-Hatch" _$ (processlayer "Defpoints") "Defpoints" _$ (processlayer "Recess-wall") "Recess-Wall" Cheers! Quote
Artek Posted August 18, 2013 Author Posted August 18, 2013 You're the man!!! Brilliant! Just one quick question. If I need to add more words to the exemptions list, how do I do that? Quote
Lee Mac Posted August 18, 2013 Posted August 18, 2013 You're the man!!! Brilliant! Thank you! Just one quick question. If I need to add more words to the exemptions list, how do I do that? There isn't an exemption list as such - I simply prevented the program from removing the 's' from items which end with double 's', (e.g. Access / Recess etc.); however, you could quite easily create an 'exemption list' by changing: ([color=BLUE]or[/color] flg ([color=BLUE]=[/color] y [color=MAROON]"DEFPOINTS"[/color])) to: ([color=BLUE]or[/color] flg ([color=blue]member [/color]y '([color=MAROON]"DEFPOINTS"[/color] [color=darkred]"EXEMPTION1" "EXEMPTION2"[/color]))) However, note that the list must be in uppercase. Quote
Artek Posted August 18, 2013 Author Posted August 18, 2013 Excellent! And just to check, if there are some layer names in abbreviated form like CW-Line or HW-Line that need to be in capital letters as well, would that be hard to do? Or will that just complicate things? Quote
Lee Mac Posted August 18, 2013 Posted August 18, 2013 Excellent! You're welcome - to clarify, note that the list should contain the sections of layer names, not complete layer names unless the layer name is composed of a single item (e.g. 'Defpoints'). And just to check, if there are some layer names in abbreviated form like CW-Line or HW-Line that need to be in capital letters as well, would that be hard to do? Or will that just complicate things? Not too difficult providing we can use the assumption that any two letter section should be capitalised. Quote
Artek Posted August 18, 2013 Author Posted August 18, 2013 Hmmm. It's not always the case because there are words that don't need to be capitalized like for example: Wall-Hatch, Roof-Frame etc. I only need to capitalize the abbreviated words like CHB, CW (for cold water), HW (hot water), WF (wall footing), CF (column footing) to name a few. I'm just thinking that maybe a list of set of letters ("CHB" "CW" "HW" "WF" "CF") like the one above seems ideal because it's editable. It must be complicated to do so just forget it. Thanks again, Lee. I'm glad that there are people like you out there who are always willing to share their knowledge. Kudos to you and this website - you're a big help. Quote
Lee Mac Posted August 18, 2013 Posted August 18, 2013 I'm just thinking that maybe a list of set of letters ("CHB" "CW" "HW" "WF" "CF") like the one above seems ideal because it's editable. It must be complicated to do so just forget it. No - not too complicated: ([color=BLUE]defun[/color] c:fixlayers ( ) ([color=BLUE]vlax-for[/color] lay ([color=BLUE]vla-get-layers[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))) ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-put-name[/color] ([color=BLUE]list[/color] lay (processlayer ([color=BLUE]vla-get-name[/color] lay)))) ) ([color=BLUE]princ[/color]) ) ([color=BLUE]defun[/color] processlayer ( str ) ( ([color=BLUE]lambda[/color] ( lst [color=BLUE]/[/color] flg ) ([color=BLUE]if[/color] ([color=BLUE]setq[/color] flg ([color=BLUE]and[/color] ([color=BLUE]cadr[/color] lst) ([color=BLUE]wcmatch[/color] ([color=BLUE]car[/color] lst) [color=MAROON]"~*[~0-9]*"[/color]))) ([color=BLUE]setq[/color] lst ([color=BLUE]vl-list*[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]strcase[/color] ([color=BLUE]cadr[/color] lst)) ([color=BLUE]cddr[/color] lst))) ) ([color=BLUE]substr[/color] ([color=BLUE]apply[/color] '[color=BLUE]strcat[/color] ([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( x [color=BLUE]/[/color] y ) ([color=BLUE]setq[/color] y ([color=BLUE]strcase[/color] x)) ([color=BLUE]strcat[/color] [color=MAROON]"-"[/color] ([color=BLUE]strcase[/color] ([color=BLUE]substr[/color] x 1 1)) ([color=BLUE]cond[/color] ( ([color=BLUE]or[/color] flg ([color=BLUE]member[/color] y '([color=MAROON]"DEFPOINTS"[/color]))) [color=GREEN];; Unaltered[/color] ([color=BLUE]substr[/color] x 2) ) ( ([color=BLUE]wcmatch[/color] y [color=MAROON]"CHB,[CH]W,[CW]F"[/color]) [color=GREEN];; Capitalised[/color] ([color=BLUE]substr[/color] y 2) ) ( ([color=BLUE]wcmatch[/color] y [color=MAROON]"*IES"[/color]) ([color=BLUE]strcat[/color] ([color=BLUE]substr[/color] x 2 ([color=BLUE]-[/color] ([color=BLUE]strlen[/color] x) 4)) ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"S"[/color] ([color=BLUE]substr[/color] x ([color=BLUE]strlen[/color] x))) [color=MAROON]"Y"[/color] [color=MAROON]"y"[/color])) ) ( ([color=BLUE]wcmatch[/color] y [color=MAROON]"*[~S]S"[/color]) ([color=BLUE]substr[/color] x 2 ([color=BLUE]-[/color] ([color=BLUE]strlen[/color] x) 2)) ) ( ([color=BLUE]substr[/color] x 2)) ) ) ) ) lst ) ) 2 ) ) (LM:mparse str '([color=MAROON]" "[/color] [color=MAROON]"_"[/color] [color=MAROON]"-"[/color])) ) ) [color=GREEN];; Multi-delimiter Parse - Lee Mac[/color] [color=GREEN];; Separates a string using a list of delimiters[/color] [color=GREEN];; str - [str] string to process[/color] [color=GREEN];; lst - [lst] list of delimiter strings[/color] ([color=BLUE]defun[/color] LM:mparse ( str lst ) ([color=BLUE]if[/color] ([color=BLUE]cdr[/color] lst) ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) (LM:mparse x ([color=BLUE]cdr[/color] lst))) (LM:parse str ([color=BLUE]car[/color] lst)))) (LM:parse str ([color=BLUE]car[/color] lst)) ) ) [color=GREEN];; Parse - Lee Mac[/color] [color=GREEN];; Separates a string using a given delimiter[/color] [color=GREEN];; str - [str] string to process[/color] [color=GREEN];; del - [str] delimiter by which to separate the string[/color] ([color=BLUE]defun[/color] LM:parse ( str del [color=BLUE]/[/color] pos ) ([color=BLUE]if[/color] ([color=BLUE]setq[/color] pos ([color=BLUE]vl-string-search[/color] del str)) ([color=BLUE]vl-remove[/color] [color=MAROON]""[/color] ([color=BLUE]cons[/color] ([color=BLUE]substr[/color] str 1 pos) (LM:parse ([color=BLUE]substr[/color] str ([color=BLUE]+[/color] 1 pos ([color=BLUE]strlen[/color] del))) del))) ([color=BLUE]list[/color] str) ) ) ([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color]) I have used a wildcard pattern for this case as it allows for more concise code. Thanks again, Lee. I'm glad that there are people like you out there who are always willing to share their knowledge. Kudos to you and this website - you're a big help. Thank you for your kind words Artek, I appreciate your gratitude for my time. Quote
Artek Posted August 18, 2013 Author Posted August 18, 2013 Wow! Thanks, Lee. You deserve all the praises because you're really good and kind. What's the meaning of the symbols '[' and ']', btw? What are they for? (wcmatch y "CHB,[CH]W,[CW]F") ;; Capitalised Quote
Lee Mac Posted August 18, 2013 Posted August 18, 2013 Wow! Thanks, Lee. You deserve all the praises because you're really good and kind. What's the meaning of the symbols '[' and ']', btw? What are they for? (wcmatch y "CHB,[CH]W,[CW]F") ;; Capitalised Refer to the documentation on the wcmatch function: http://exchange.autodesk.com/autocad/enu/online-help/browse#WS1a9193826455f5ff1a32d8d10ebc6b7ccc-6754.htm You will see that: ([color=blue]wcmatch[/color] [i][color=green]<string>[/color][/i] [font=Courier New][color=darkred]"[CH]W"[/color][/font]) Will match both CW & HW Quote
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.