Laylist LISP modification

[cdavis]

Hi,

I have a lisp that I use when I am generating custom legends. The lisp lets me select items or just insert all layers. It gives you a line with corresponding text with layer name and the description. The only thing is that it does not list the layers in alphabetical order. Would someone be able to modify this so that the list comes in alphabetical order?

[paullimapa · Accepted solution]

try the attached revised version

[marko_ribar · Accepted solution]

Here is mine...

Untested, though, but should work...

(defun c:laylist ( / laylist2 pt rsp dat ln lst desln )

  (defun laylist2 ( pt ln / desln )
    (entmake (list (cons 0 "line") (cons 10 pt) (cons 11 (mapcar (function +) pt (list 2.5 0.0))) (cons 8 ln)))
    (entmake (list (cons 0 "text") (cons 10 (mapcar (function +) pt (list 3.0 0.0))) (cons 40 0.1) (cons 1 ln) (cons 8 ln)))
    (if (/= 0 (strlen (setq desln (getpropertyvalue (tblobjname "layer" ln) "Description"))))
      (entmake (list (cons 0 "text") (cons 10 (mapcar (function +) pt (list 4.5 0.0))) (cons 40 0.1) (cons 1 desln) (cons 8 ln)))
    )
    (mapcar (function -) pt (list 0.0 0.15))
  )

  (initget "All Select")
  (setq pt (getpoint "\nSelect insertion point : "))
  (initget "Select All")
  (setq rsp (getkword "\nSpecify option [Select / All] <All> : "))
  (cond
    ( (= rsp "Select")
      (mapcar
        (function (lambda ( x )
          (setq pt (laylist2 pt x))
        ))
        (progn
          (mapcar
            (function (lambda ( x )
              (and (null (member x lst)) (setq lst (cons x lst)))
            ))
            (mapcar
              (function (lambda ( x )
                (cdr (assoc 8 (entget x)))
              ))
              (vl-remove-if (function listp)
                (mapcar (function cadr) (ssnamex (ssget)))
              )
            )
          )
          (acad_strlsort lst)
        )
      )
    )
    ( t
      (while (setq dat (tblnext "layer" (null dat)))
        (setq lst (cons (cdr (assoc 2 dat)) lst))
      )
      (foreach ln (acad_strlsort lst)
        (setq pt (laylist2 pt ln))
      )
    )
  )
  (princ)
)

[komondormrex · Accepted solution]

@cdavis 

hey,

check this mod to your code

(defun c:laylist  (/ pt rsp dat ln lst desln)
 (initget "All Select")
 (setq pt (getpoint "\nSelect insertion point: "))
 (initget "Select All")
 (setq rsp (getkword "\nSpecify option [Select / All] <All>:"))
 (cond ((= rsp "Select")
        (mapcar '(lambda (x) (setq pt (laylist2 pt x)))
                (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)))
       (t (while (setq dat (tblnext "layer" (null dat))) (setq lst (cons (cdr (assoc 2 dat)) lst)))
       		 (mapcar '(lambda (x) (setq pt (laylist2 pt x))) (acad_strlsort lst))
       )
 )
 (princ))

(defun laylist2  (pt ln / desln)
 (entmake (list '(0 . "line") (cons 10 pt) (cons 11 (mapcar '+ pt '(2.5 0))) (cons 8 ln)))
 (entmake (list '(0 . "text") (cons 10 (mapcar '+ pt '(3.0 0))) '(40 . 0.1) (cons 1 ln) (cons 8 ln)))
 (if (zerop (strlen (setq desln (getpropertyvalue (tblobjname "layer" ln) "Description"))))
  ()
  (entmake (list '(0 . "text") (cons 10 (mapcar '+ pt '(4.5 0))) '(40 . 0.1) (cons 1 desln) (cons 8 ln))))
 (mapcar '- pt '(0 0.15)))

[cdavis]

Thank you all for these. 3 of them worked great, I appreciate this community, I have never been let down in 20+ years of drafting and standards.

Thanks again!

Chris

[Sea-Haven]

Maybe another does blocks as well.

; make legend
; May 2024 By AlanH

(defun RemoveDupes (InLst / OutLst CarElm)
  (while InLst
  (setq
    InLst (vl-remove (setq CarElm (car InLst)) (cdr InLst))
    OutLst (cons CarElm OutLst)
  )
  )
)

(defun makelegend ( /  ss lst lstrem obj pt pt2 ltname x val bname)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setvar 'textstyle "Standard")
(setq oldlay (getvar 'clayer))
(setvar 'clayer "0")

(setq ss (ssget "X" (list (cons 410 "Model"))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq lst (cons (list (vla-get-layer obj) (vlax-get obj 'Linetype)) lst))
)
(setq lst (RemoveDupes lst))
(setq lst (vl-sort lst '(lambda (x y) (<  (car x) (car  y)))))


(setq pt (getpoint "\nPick point for line legend "))
(setq pt2 (mapcar '+ pt (list 125.0 0.0 0.0)))

(foreach ltname lst
(command "line" pt (mapcar '+ pt (list 20.0 0.0 0.0)) "")
(command "chprop" (entlast) "" "LA" (car ltname) "LT" (cadr ltname) "S" 0.25 "")
(command "text" (mapcar '+ pt (list 25.0 0.0 0.0)) 2.5 0.0 (car ltname))
(setq pt (mapcar '+ pt (list 0.0 10.0 0.0)))
)

(setq lst '())
(setq attreq 0)

(repeat (setq x (sslength ss))
  (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
  (if (= (vla-get-objectname obj) "AcDbBlockReference")
  (setq lst (cons (vla-get-name obj) lst))
  )
)
(setq lst (RemoveDupes lst))
(setq lst (vl-sort lst '(lambda (x y) (<  x  y))))

(foreach val lst
(if (wcmatch val "*U#*" )
(setq lst (vl-remove val lst))
)
)

(foreach bname lst
(progn
  (command "text" (mapcar '+ pt2 (list 25.0 0.0 0.0)) 2.5 0.0 bname)
  (command "-insert" bname pt2 1 1 0)
  (setq pt2 (mapcar '+ pt2 (list 0.0 10.0 0.0)))
  (setq obj (vlax-ename->vla-object (entlast)))
  (vla-GetBoundingBox obj 'minpoint 'maxpoint)
  (setq pointmin (vlax-safearray->list minpoint))
  (setq pointmax (vlax-safearray->list maxpoint))
  (setq ht (- (cadr pointmax)(cadr pointmin)))
  (setq xscale (/ 5.0  ht))
  (vla-put-xscalefactor obj xscale)
  (vla-put-yScaleFactor obj xscale)
)
)

(setvar 'osmode oldsnap)
(setvar 'clayer  oldlay)
(princ)
)
(makelegend)

[Regan.Flavelle]

Thanks for this code! It's been very helpful. I'm still trying to finagle a little something extra thrown in. I've amended it to print line-color-layer-description, and I though I could amend it further to add linetype between color and layer, but it's not working out. Instead it only prints the first line and the first color code. LayList is on the left and LayList - Test is on the right in the below screenshot.

I'm very new to this kind of coding, so I'm feeling pretty lost on what I'm doing wrong. I really want to use this to map out new plot styles for my office so I can visually compare them to existing styles. Any thoughts?

Thanks so much in advance!

---

[paullimapa]

there's additional code to get the linetype name.

try replacing in your laylisttest.lsp code under your laylistsub function this line:

    (if (/= 0 (strlen (setq desln (getpropertyvalue (tblobjname "layer" ln) "Linetype"))))

with this line:

    (if (/= 0 (strlen (setq desln (getpropertyvalue (getpropertyvalue (tblobjname "layer" ln) "LinetypeObjectId") "Name"))))