Lisp to create lines and text on each layer in DWG

I am sorry, I did NOT search this..

but i am looking for a lisp that will create a table that creates the following on each layer in the drawing.

column 1 = layer name in standard text

column 2 = layer color in standard text

column 3 = layer linetype in standard text

column 4 = layer lineweight in standard text

column 5 = layer transparency in standard text

column 6 = layer plot (yes/no) in standard text

column 7 = a line 1" (or unit) long

i want this in a DWG file so i can plot with our settings.

i know there is a way to export to excel.. that information would be great as well!!

thank you for helping a lazy/busy guy out!!!

i know there is a way to export to excel.. = "You use the Data Extraction wizard" check help

using lisp etc you can pull all the info out of the layer table now where is a example.

Open the layer dialog; select all; ctrl+c; paste into excel.

using lisp also check out help under customization tblnext

(while (setq lay (tblnext "layer"))
(princ lay)
)

Open the layer dialog; select all; ctrl+c; paste into excel.

That is a useful tip. I never knew you could copy those details from there.

Here's an old routine

(defun c:Laytable (/ aDoc    pt      Ltable  row_nos row_num ColNum
      row_nos BFlag   fpt     lylst   lyn     ss
      typ
     )
 (vl-load-com)
 (setq aDoc (vla-get-activedocument (vlax-get-acad-object)))
 (defun _Dxf (en as flg) (cdr (assoc as (if flg en
   (entget en)
 )
 )
   )
 )
 (if (and
(tblsearch "BLOCK" "1inch")
(setq pt (getpoint "\nTable Insertion Point:"))
(setq Ltable
       (vlax-invoke
  (vlax-get (vla-get-ActiveLayout aDoc) 'Block)
  'Addtable
  pt
  2
  6
  10
  35
       )
)
(progn
(vla-settext Ltable 0 0 (vl-filename-base (getvar 'DWGNAME)))
(setq row_nos -1)
 (mapcar '(lambda (i k)
      (vla-SetcolumnWidth Ltable (setq row_nos (1+ row_nos)) k)
      (vla-settext Ltable 1 row_nos i)
    )
   '("Name" "Color" "LType" "LWT" "Plot" "Sample")
   '(100.0 30 50.0 40.0 20.0 30.0)
 )
    (vla-put-regeneratetablesuppressed Ltable :vlax-true)
(setq row_num (vla-get-rows Ltable))
  (vla-insertrows Ltable row_num 10 1)
T
)
   )
(progn    
(while (setq a (tblnext "LAYER" (null a)))
 (if (not (member (setq lyn (_Dxf a 2 T)) '("0" "Defpoints")))
   (progn
     (setq b    (tblobjname "LAYER" lyn)
    ColNum -1
    Lylst  (cons lyn Lylst)
     )
  (vla-insertrows Ltable (setq row_num (1+ row_num)) 10 1)
  (Foreach itm
    (mapcar
      '(lambda (j / typ)
  (setq typ (_Dxf b j nil))
  (cond
    (( = j 370)
      (setq typ (if ( = typ -3) "Default" (itoa typ))))
    (( = j 290)
      (setq typ 
      (if ( = typ 1) "Yes" "No")))
    )
  typ
  
  )
      '(2 62 6 370 290)
    )
    (vla-settext Ltable row_num (setq ColNum (1+ ColNum)) itm)
  )
  (vla-SetCellType Ltable row_num (1+ ColNum) acBlockCell)
  (vla-SetBlockTableRecordId
    Ltable
    row_num
    (1+ ColNum)
    (vla-get-Objectid
      (vla-item (vla-get-blocks adoc) "1inch")
    )
    :vlax-true
  )
  
     )
   )
 )
     (vla-put-regeneratetablesuppressed Ltable :vlax-false)
  (command "_zoom" "O" (entlast) "")
  (command "_explode" (entlast))
  (setq ss     (ssget "W"
        (setq
   fpt (polar pt 4.71238898 30.00)
    ;(* (setq rn_ (- row_num 2)) 10.00))
        )
        (list (+ (car fpt) 270.00)
       (- (cadr fpt) (* (- row_num 1) 10.00))
       (last fpt)
        )
        '((0 . "MTEXT,INSERT"))
        )
 i      (sslength ss)
 lylst_ (reverse lylst)
  )
  (while (setq a (car lylst_))
    (repeat 5
      (setq ent (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 8 a) (assoc 8 ent) ent))
    )
    (setq lylst_ (vl-remove a lylst_))
  )
  (foreach itm (reverse lylst)
    (setq ent (entget (ssname ss (setq i (1- i)))))
    (entmod (subst (cons 8 itm) (assoc 8 ent) ent))
  )
)(princ "\n<< Block Not Found >>")
     )
  (princ)
   )

CODE UPDATED:

HTH

@pBe - the routine worked.. however, each cell of the table was on zero layer. I was hoping to get the contents of each cell on the layer it lists.

@alanjt - that will work.. and is not hard to do. thank you.

@bigal - can you explain a but further?

the reason i want the text and line work, it so i can plot out and make sure the lineweight and dithering and other variables are set up correctly.

i did find this.. http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/layer-plot/m-p/2335067/highlight/true#M266533

it is a start for what i want.

@pBe - the routine worked.. however, each cell of the table was on zero layer. I was hoping to get the contents of each cell on the layer it lists.

I think we can work it out. Do you want to exclude layer "0" & "Defpoints"?

Updated code at post #6

thank you..

those 2 layers do not matter much. ;-)

2 things i noticed..

1) line weight decimal is off. showing 13 instead of 0.13

2) can plot be transparency instead? i no longer care about plot.. and if the layer plot is turned off.... umm... yeah.. lol.

if so.. this lisp is perfect and exactly what i am looking for!!

2 things i noticed..

1) line weight decimal is off. showing 13 instead of 0.13

look for this:

((= j 370)
 (setq typ (if (= typ -3)
      "Default"
      (itoa typ)
    )
 )
)

Chang it to this

((= j 370)
 (setq typ (if (= typ -3)
      "Default"
      (rtos (* typ 0.01) 2 2)
    )
 )
)

2 things i noticed..

2) can plot be transparency instead? i no longer care about plot.. and if the layer plot is turned off.... umm... yeah.. lol.

 

if so.. this lisp is perfect and exactly what i am looking for!!

Glad it worked for you.

Cheers