Jump to content

Recommended Posts

Posted

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.

Posted

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

Posted

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.

Posted (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... :oops:

 

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 by Artek
Additional condition and explanation
Posted
Nice code, Lee! :thumbsup:

 

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!

Posted

You're the man!!! Brilliant! :D Just one quick question. If I need to add more words to the exemptions list, how do I do that?

Posted
You're the man!!! Brilliant! :D

 

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.

Posted

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?

Posted
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.

Posted

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.

Posted
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.

Posted

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

Posted
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

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...