LISP to create a line and text from a layer name

[Anonymous]

I am new to LISP and was wondering if it is possible to draw a line and then another below that (such as an array) one each for all the layers in a drawing? I would also like to create text next to the line that has the name of the layer. This line and text should be on the layer in question.

I can do it manually but wondered if was easier to automate!

Many thanks for your time

Adam

[pbejse]

This in blue

        (progn (acad_strlsort (mapcar '(lambda (x) (and (null (member x lst)) (setq lst (cons x lst))))
                                      (mapcar '(lambda (x) (cdr (assoc 8 (entget x))))
                                              (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget)))))))
               lst)

to this in red

(progn (mapcar '(lambda (x) (and (null (member x lst)) (setq lst (cons x lst))))
                              (mapcar '(lambda (x) (cdr (assoc 8 (entget x))))
                                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget))))))
       (acad_strlsort lst))

[tranminhthong0993]

Bother you too but has not yet run ☹️

[chrisb6F6PK]

Thanks all for the routines.  I did some modifications...

Filter out xref layers, added a description to the layer name.

(defun c:test ( / doc lyrs lst pt both)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        lyrs (vla-get-layers doc)
  );end_setq
  (vlax-for lyr lyrs (setq lst (cons (vlax-get lyr 'name) lst)))
  (setq lst (vl-sort lst '< )
        pt (getpoint "\nSelect insertion point: ")
  );end_setq
  (foreach lyr lst
(if (not (wcmatch lyr "*|*"))
(progn
(if (zerop (strlen (setq desln (getpropertyvalue (tblobjname "layer" lyr) "Description"))))(setq both lyr)(setq both (strcat lyr " (Description) " (getpropertyvalue (tblobjname "layer" lyr) "Description"))))
    (entmakex (list '(0 . "line") (cons 10 pt) (cons 11 (mapcar '+ pt '(2.5 0 0))) (cons 8 lyr)))
    (entmakex (list '(0 . "text") (cons 10 (mapcar '+ pt '(3.0 0 0))) '(40 . 0.1) (cons 1 both) (cons 8 lyr)(cons 7 "RE Text")))
    (setq pt (mapcar '- pt '(0 0.15 0)))
));end_if_pron
  );end_foreach
  (princ)
)

[tdeleske]

Hi chrisb6F6PK, I am trying this routine is almost what I am looking for, however, instead of the Layer description, how can I change it to show me the Layer Linetype names in the text output?

[Kent1Cooper]

---

@tdeleske wrote:

.... instead of the Layer description, how can I change it to show me the Layer Linetype names in the text output?

---

Try [untested] replacing this part:

(if (zerop (strlen (setq desln (getpropertyvalue (tblobjname "layer" lyr) "Description"))))
(setq both lyr)(setq both (strcat lyr " (Description) " (getpropertyvalue (tblobjname "layer" lyr) "Description"))))

with this:

(setq both (strcat lyr " (Linetype) " (cdr (assoc 6 (entget (tblobjname "layer" lyr))))))

[tdeleske]

Thank you Kent! it worked perfect! much apricated.

Regards

Trevor

[JGAo1]

Thanks for this lisp, it works perfectly.

[jzweygardt]

This is very helpful. Thanks a bunch!

[ccarva2]

Try this:

(defun c:somefunc (/ pt dat ln layerlist sortedlayerlist)
(setq pt (getpoint "\nSelect insertion point: "))

(setq layerlist '())

(while (setq dat (tblnext "layer" (null dat)))
(setq layerlist (cons (cdr (assoc 2 dat)) layerlist))
)

(setq sortedlayerlist (acad_strlsort layerlist))

(foreach ln sortedlayerlist

(entmake (list '(0 . "line") (cons 10 pt) (cons 11 (mapcar '+ pt '(2.5 0 0))) (cons 8 ln)))

(entmake (list '(0 . "text") (cons 10 (mapcar '+ pt '(3.0 0 0))) '(40 . 0.1) (cons 1 ln) (cons 8 ln)))

(setq pt (mapcar '- pt '(0 0.15 0)))
)

(princ)
)