Create layer based on another layer

I would like to draw text on a layer that is a modification of a selected line's layer. For example: The line's layer is M-HVAC-SUPP-1LIN.. A routine would be run that would ask the user to pick the line and would then draw text on layer M-HVAC-SUPP-ANNO. Or, if the line is on M-EXHS-1LIN, the text would be drawn on M-EXHS-ANNO.

How can you obtain the layer name and reuse a portion of it?

 

(setq Ent (entsel "\n Select line: "))
(setq Lay (cdr (assoc 8 (entget Ent))))
(setq NewLay (strcat Lay "-Anno"))
(command "_.layer" "_m" NewLay)

I think that will get you want you want, as far as getting the layer of the line, then making a layer, or making it current if it already exist within the drawing.

Tim

 

except if you look at the original post, he wants to discard the -1LIN from
the layername and then add -ANNO

Question for ctindall.... is it always the same suffix -1LIN that you want
to get rid of? or the same length? What if it isn't -1LIN, do you want to
subtract something else, or just append the -ANNO?

Casey

the line, then making a layer, or making it current if it already exist
within the drawing.

 

Oops, didn't read it close enough.
But it is a starting point.

Tim

 

If it is always after the last "-" in the layer name you do it like this

(setq temp1 0)
(while (setq temp1 (vl-string-search "-" Lay (1+ temp1)))
(setq temp2 temp1)
)
(setq NewLay (strcat (substr Lay 1 (1+ temp2)) "Anno"))

Tim

 

It will be after the third "-", unless there is not a third "-" then it will be after the second "-" (or the first "-" if there is not second "-")

It will never be after the fourth "-"

Thanks for the suggestions. I'll try to play around with them tonight.

Chris

 

Try the following...the last function, annolayer, requires the first two
functions. annolayer takes a layer name as its first argument, the "new"
field as its second argument and has no error checking.

examples:
(annolayer "M-HVAC-SUPP-1LIN" "ANNO") returns "M-HVAC-SUPP-ANNO"
(annolayer "M-HVAC-1LIN" "ANNO") returns "M-HVAC-ANNO"
(annolayer "M-HVAC" "ANNO") returns "M-ANNO"
(annolayer "M" "ANNO") returns "ANNO"



;;;The following are from Autolisp Programming for Productivity by Bill
Kramer
;;;parses a string (s) into a list of smaller strings using a single- or
multi-char
;;;delimeter (del)
(defun sparse (s del / ll tmp cnt dellen)
(setq tmp ""
cnt 0
dellen (strlen del)
)
(while (< cnt (strlen s))
(setq cnt (1+ cnt))
(if (= (substr s cnt dellen) del)
(setq ll (cons tmp ll)
tmp ""
cnt (+ cnt (1- dellen))
)
(setq tmp (strcat tmp (substr s cnt 1)))
)
)
(reverse (cons tmp ll))
)

;;;The following is the reverse of the previous: "un"parses a list of text
;;;strings (lstr) into a single text string adding a delimeter (del).
;;;The delimiter is placed only between the atoms
(defun unsparse (lst delim)
(apply 'strcat
(cons (car lst)
(mapcar
'(lambda (s)
(strcat delim s)
)
(cdr lst)
)
)
)
)

;swaps the last field of layer (string in "-" delimited format) with
newfield (string)
;requires functions sparse and unsparse
(defun annolayer (layer newfield)
(unsparse (reverse (append (list newfield) (cdr (reverse (sparse layer
"-"))))) "-")
)

line's layer. For example: The line's layer is M-HVAC-SUPP-1LIN.. A
routine would be run that would ask the user to pick the line and would then
draw text on layer M-HVAC-SUPP-ANNO. Or, if the line is on M-EXHS-1LIN, the
text would be drawn on M-EXHS-ANNO.

 

See if this works for you.

Tim

(defun c:MakeNewLayer (/ Ent Lay NewLay temp1 temp2)
; Create new layer and make current

(if (setq Ent (entsel "\n Select object on layer to copy: "))
(progn
(setq Lay (cdr (assoc 8 (entget (car Ent)))))
(setq temp1 0)
(while (setq temp1 (vl-string-search "-" Lay (1+ temp1)))
(setq temp2 temp1)
)
(setq NewLay (strcat (substr Lay 1 (1+ temp2)) "Anno"))
(command "_.layer" "_m" NewLay "")
(prompt (strcat "\n New layer \"" NewLay "\" created."))
)
(prompt "\n Nothing selected.")
)
(princ)
)

 

If it will always be the LAST FOUR characters (no matter how many hyphens
there are) that you want to replace with ANNO, you can do something
relatively simple like this:

[picking up on Tim's earlier starting point, except he's missing the (car...
part in the second line...]

(setq Ent (entsel "\n Select line: "))
(setq Layold (cdr (assoc 8 (entget (car (Ent))))))
(setq lengthold (strlen Layold))
(setq lengthtemp (- lengthold 4))
(setq Laybase (substr Layold 1 lengthtemp))
(setq NewLay (strcat Laybase "Anno"))
(command "_.layer" "_m" NewLay)

Some of those lines could be collapsed together, if you want, and eliminate
some variables (watch for word wrap):

(setq Layold (cdr (assoc 8 (entget (car (entsel "\n Select line: "))))))
(setq NewLay (strcat (substr Layold 1 (- (strlen Layold) 4)) "Anno"))
(command "_.layer" "_m" NewLay)

 

well, i dunno what version you guys are using but in 2005 all you have to do
it select the layer and click the new... it will use all the same props and
all you have to do is add the name...

 

But you have to do that in the Layer dialog box. And it involves typing in
the whole layer name (at least in 2004, it doesn't start with the name the
same as the layer you select, though it does the other properties, so you
don't get most of it entered for you). And then you have to select to have
that be the current layer. The other approaches you can do (as I think the
original post wanted) just by invoking them and picking an object on-screen.

 

This works very well. I've tried to add an mtext function after this routine and then swithc the layer back to the previous layer state. What am I doing wrong?


(defun c:MMT (/ Ent Lay NewLay temp1 temp2)
(setq CurrentLay (GETVAR "clayer")
)
(if (setq Ent (entsel "\n Select object on layer to copy: "))
(progn
(setq Lay (cdr (assoc 8 (entget (car Ent)))))
(setq temp1 0)
(while (setq temp1 (vl-string-search "-" Lay (1+ temp1)))
(setq temp2 temp1)
)
(setq NewLay (strcat (substr Lay 1 (1+ temp2)) "Anno"))
(command "_.layer" "_m" NewLay "")
(prompt (strcat "\n New layer \"" NewLay "\" created."))
)
(prompt "\n Nothing selected.")
)
(initdia)
(command "_.MTEXT")
(setvar clayer CurrentLay)
(princ)
)

 

To get Mtext to wait add this instead of what you have.
But there is a trick to mtext that I don't know, so it won't set the layer then do the mtext. So your mtext won't be on the right layer.

Hope that is clear.

Tim

(initdia)
(command "_.Mtext")
(while (> (getvar "cmdactive") 1)
(command pause)
)

 

Here's one way to get that new layer name. It's even got a little bit of error checking, such as, you have to pick a LINE, and the name of the layer of the LINE has to have at least one dash in it.

First select a line using entsel.

(setq ename (entsel "\nSelect a LINE: ")).

If you select anything, entsel returns a list consisting of, first, the entity name, and second, a nested list of three reals representing the coordinates of the pick point. If you pick an empty area on the screen, entsel returns nil.

Next if entsel returns a non-nil value, that is, you actually selected something, pull out the entity name alone.

(setq ename (car ename))

Now get the entity data for ename using entget.

(setq edata (entget ename))

The entity data consists of an association list. The entity type is associated with 0, the layer is associated with 8. (See the online help under "DXF reference" for a better explanation of how to interpret entity data in AutoLISP.) Check edata to make sure you selected a LINE and not some other kind of entity.

(if (= "LINE" (cdr (assoc 0 edata)))

and if so, continue, else bail out with an error message. Next step, get the layer that the line is on

(setq elayer (cdr (assoc 8 edata)))

ELAYER will be a string. You can work your way from the back of the string, or to make it easier (at least I think it's easier) reverse the string and work from the front of it. You can reverse the string with this little subroutine called "gnirts." (gnirts "ABCDEF") returns "FEDCBA".

(setq backwards_elayer (gnirts elayer))

Next set the variable OK to T.

(setq OK T)

Now snip off one character at a time from the reversed layer name until either a.) you run into a dash, or b.) you've snipped off all the characters.

(while (and OK (/= backwards_elayer ""))
(setq letter (substr backwards_elayer 1 1)
backwards_elayer (substr backwards_elayer 2)
)
(if (= "-" letter)
(setq OK nil) ; loop no more!
)
)

If there was a dash in backwards_elayer when the while loop started, then the while loop terminated, and what was left in backwards_elayer is the part before the dash, reversed. If there was no dash in backwards_elayer before the while loop, then it picked off all the letters and backwards_elayer is now the empty string "". So check to see if backwards_elayer is "" and if not, reverse what's left of backwards_elayer (so it's now in the right direction) and concatenate "-ANNO", and this will give you the new layer name you want. Take it from there!

(if (/= "" backwards_elayer)
(progn
(setq new_layer (strcat (gnirts backwards_elayer) "-ANNO"))
; do stuff with new_layer
)
)

The whole schmear:

(defun C:TEXT-O-LINE()
(setq new_layer nil)
(if (setq ename (entsel "\nSelect line: "))
(progn
(setq ename (car ename))
(setq edata (entget ename))
(if (= "LINE" (cdr (assoc 0 edata)))
(progn
(setq elayer (cdr (assoc 8 edata))) ; this is the name
; of the layer of the
; selected LINE entity
(setq backwards_elayer (gnirts elayer))
(setq OK T)
(while (and OK (/= "" backwards_elayer))
(setq letter (substr backwards_elayer 1 1)
backwards_elayer (substr backwards_elayer 2)
)
(if (= letter "-")
(setq OK nil)
)
)
(if (/= "" backwards_elayer)
(progn
(setq new_layer (strcat (gnirts backwards_elayer) "-ANNO"))
; do stuff with new_layer... your code goes here!
)
(princ "\nThere was no dash in the name of the layer of the LINE you selected.")
)
)
(princ "\nThe entity you selected was not a LINE.")
)
)
(princ "\nYou didn't select any entity. ")
)
)

(defun gnirts(str / outstr )
(setq outstr "")
(if (= (quote str)(type str))
(while (/= str "")
(setq outstr (strcat (substr str 1 1) outstr) str (substr str 2))
)
(setq outstr nil)
)
outstr
)