Topic: Layers to text lisp

[ELOQUINTET]

Hey guys,

Long time no post! I have a need for a lisp that would generate text on all of the layers in a drawing.
This text will then be used to create a block to put onto a palette to easy bring standard layers back into a drawing.
I figured someone had probably written something like this in the past so I figured I'd ask around.
I would really prefer a lisp file because we have removed VBA from our environment, for now.
Thanks in advance

[Mark]

Hi Dan!

a lisp that would generate text on all of the layers in a drawing

Like generate a text file?

[Bhull1985]

I believe OP wants to add a text entity into each existing layer, then wblock all of the entities at once so that when inserted into a new drawing, all of those layers would be brought in as well.

[ELOQUINTET]

Hey Mark,

Bhull was partially correct. I don't really need to export the layers to excel/cvs, etc.
I have a routine to do this already anyways.

What I need to do is create a text object on each layer in the drawing.
I don't really need to wblock it as Bhull said as we will be breaking the layers into smaller groups (i.e. 3d , demo, etc.)
Thanks

[David Bethel]

maybe :

Code: [Select]

(defun c:test (/ td i ln)
  (setq i 1)
  (while (setq td (tblnext "LAYER" (not td)))
         (if (/= "0" (setq ln (cdr (assoc 2 td))))
             (entmake (list (cons 0 "TEXT")
                            (cons 1 ln)
                            (cons 6 "BYLAYER")
                            (cons 7 (getvar "TEXTSTYLE"))
                            (cons 8 (cdr (assoc 2 td)))
                            (cons 10 (list 0 i 0))
                            (cons 11 (list 0 i 0))
                            (cons 39 0.0)
                            (cons 40 1.0)
                            (cons 41 1.0)
                            (cons 50 0.0)
                            (cons 51 0.0)
                            (cons 62 256)
                            (cons 71 0)
                            (cons 72 0)
                            (cons 73 0)
                            (cons 210 (list 0 0 1)))))
         (setq i (+ i 2)))
   (prin1))


-David

[ELOQUINTET]

David,

That is sort of what I am looking for but how hard would it be to not have the text one on top of the other and to have the text read as the actual layer name instead of just layer?

[ronjonp]

If you're just using this to "bring in standard layers" why not use a template? IMO seems much simpler.

[David Bethel]

Dan,

Modified ( post 4 ) to use the layer name and increase along the Y axis.

I figured there was no reason to include layer 0 as you cannot import any values to it.

-David

[ELOQUINTET]

Thanks David exactly what the doctor ordered. Ron I am receiving this request from someone else but I think by putting them on a palette this would allow us to easily manage the layers in "groups" per department/discipline, etc. We could probably do this using design center but our users are not that sophisticated and besides they have the palettes open all of the time. Thanks for the quick responses guys.

[danallen]

my version, draws a box and line, with label

Code: [Select]

; **********************************************************
; MKLAYTXT.LSP (c) Dan Allen 1998
; derived from
; SAVLAY.LSP
; Copyright (c) Barry R. Bowen 1992
; ----------------------------------------------------------

(defun c:MAKECLAYERTEXT () (MAKELAYERTEXT (getvar "clayer")) (princ))
(defun c:MAKELAYERTEXT ( / lay)
  (princ (strcat "\nCreate layer list - text size: " (rtos (getvar "textsize"))))
  (setq lay (strcase (getstring "\nEnter layer name pattern <*>: ")))
  (if (= lay "") (setq lay "*"))
  (MAKELAYERTEXT lay)
  (princ)
)

(defun MAKELAYERTEXT (laymatch / pt px py ts n tprmpt tr iy ix ix2 pty1 pLx1 pLx2
                     l_list llist lname laycons elast)
  (SETV "cmdecho" 0)
  (SETV "clayer" "0") ;set to layer 0
  (SETV "cecolor" "bylayer")
  (setq pt    (getpoint "Select point to start text <0,0>: "))
  (if (not pt) (setq pt (list 0.0 0.0 0.0)))
  (setq llist (tblnext "layer" T)
        px    (car pt)
        py    (cadr pt)
        ts    (if (ABC_stylefixed) ;get default textsize
                (progn (setq tprmpt (list "")) ; trap for text command prompt
                       (ABC_stylefixed)) ;from style if fixed
                (progn (setq tprmpt (list "" "")) ; trap for text command prompt
                  (getvar "textsize")) ;from variable if not
              )
        tr    (/ ts 0.09375) ;txtsize ratio to 3/32" (basis for layout)
        iy    (* ts 1.67) ;vertical text increment
        ix    (* tr 1.5) ;distance from text to line
        ix2   (* tr 3.0) ;line length
        ix3   (* iy 3) ;distance from line to color text
        ix4   (* iy 1) ;distance from color text to linetype
        elast (entlast) ;remember last entity
  )
  (SETV "osmode" 0)
  (command "undo" "begin")
  (while (/= llist nil) ;get layer list
    (setq lname (cdr (assoc 2 llist))) ;get layer name
    (if (and (not (wcmatch lname "0")) ;skip layer 0 and defpoints
             (not (wcmatch (strcase lname) "DEFPOINTS")) ;
             (not (wcmatch lname "*|*")) ;check to make sure not an xref layer
                  (wcmatch lname laymatch)) ;check to see if it matches parameter
        (setq l_list (cons lname l_list)) ;add to list
    ) ;end if
    (setq llist (tblnext "layer")) ;forward to next layer
  ) ;end while

  (if l_list ;sort list alphabetically
    (setq l_list (ACAD_STRLSORT l_list)) ; built-in acad subroutine
  )

  (foreach lname l_list
    (setq lcol  (itoa (abs (cdr ;get layer color w/color name
                  (assoc 62 (tblsearch "layer" lname))))) ; from external routine
          ltyp  (strcat "("
                  (cdr (assoc 6 (tblsearch "layer" lname))) ;get layer linetype
                  ")"
                )
          pty1  (strcat (rtos px 2 8) "," (rtos py 2 8)) ;layer name text location
          pLx1  (strcat (rtos (+ px ix) 2 8) ;start point of line
                        ","
                        (rtos py 2 8))
          pLx2  (strcat (rtos (+ px ix ix2) 2 8) ;end point of line
                        ","
                        (rtos py 2 8))
          pSx1  (strcat (rtos (+ px ix ix2) 2 8) ;1st point of solid
                        ","
                        (rtos (- py (* 0.5 iy)) 2 8))
          pSx2  (strcat (rtos (+ px ix ix2) 2 8) ;2nd point of solid
                        ","
                        (rtos (+ py (* 0.5 iy)) 2 8))
          pSx3  (strcat (rtos (+ px ix ix2 iy) 2 8) ;3rd point of solid
                        ","
                        (rtos (- py (* 0.5 iy)) 2 8))
          pSx4  (strcat (rtos (+ px ix ix2 iy) 2 8) ;4th point of solid
                        ","
                        (rtos (+ py (* 0.5 iy)) 2 8))
          ptx2  (strcat (rtos (+ px ix ix2 ix3) 2 8) ;start point of color text
                        ","
                        (rtos py 2 8))
          ptx3  (strcat (rtos (+ px ix ix2 ix3 ix4) 2 8) ;start point of linetype text
                        ","
                        (rtos py 2 8))
          py   (- py iy) ;increment y position
    )
    (setvar "clayer" "0")
    (setvar "cecolor" "8")
;;    (command "text" "ml" pty1) ;add background text in color 8 layer 0
;;    (foreach n tprmpt (command n))(command lname) ;trap for fixed style height
    (setvar "cecolor" "bylayer")
    (command "-layer" "thaw" lname "set" lname "")
;;    (setvar "clayer" lname)
    (command "text" "ml" pty1) ;add foreground text in layer color
      (foreach n tprmpt (command n))(command lname)
    (command "line" pLx1 pLx2 "")
    (command "solid" pSx1 pSx2 pSx3 pSx4 "")
    (command "text" "mr" ptx2) ;add layer color number
      (foreach n tprmpt (command n))(command lcol)
    (if (/= "(CONTINUOUS)" ltyp) ;if not continuous
      (progn
        (command "text" "ml" ptx3) ; add layer linetype
          (foreach n tprmpt (command n))(command ltyp)
      )
    )
  ) ;end foreach
  ;(command "select" (ABC_AFTER elast) "") ;select new entities to be used as previous
  (command "undo" "end")
  (RSETV "cecolor")
  (RSETV "clayer")
  (RSETV "osmode")
  (RSETV "cmdecho")
  (princ)
)
;==========================================================
; Does current text style have a fixed height?
; - from Looking Glass Microproducts
;==========================================================
(Defun ABC_stylefixed (/ tsize)
   (If (/=
          0.0
          (Setq
             tsize (CDR
                      (Assoc
                         40
                         (TblSearch "style" (GetVar "textstyle"))
                      )
                   )
          )
       )
      tsize
   )
)

;==========================================================
; SETV function saves setvar settings to be reset at end with RSETV
;     (setv "cmdecho" 0) set cmdecho off
;     (rsetv "cmdecho")  resets cmdecho (see below)
;   taken from Essential AutoLISP by Roy Harkow
;==========================================================
(defun-q SETV (sysvar newval / cmdnam)
  (setq cmdnam (read (strcat sysvar "1"))) ;Create   [savevar]1
  (set cmdnam (getvar sysvar)) ;Save     [savevar]'s value
  (setvar sysvar newval) ;Then set [savevar] to new value
)




(defun-q RSETV (sysvar / )
  (if (eval (read (strcat sysvar "1"))) ;Only change if exists
    (progn
      (setq cmdnam (read (strcat sysvar "1"))) ;Create   [savevar]1
      (setvar sysvar (eval cmdnam)) ;Restore  [savevar]'s value
      (set cmdnam nil)
    ) ;end progn
  ) ;end if
)



[V-Man]

danallen

There is a No Function Def. for "SETV"

[danallen]

danallen

There is a No Function Def. for "SETV"

fixed that, added at bottom of code