Need Layer Description

[madcadder]

I have the following LISP that used to work perfect, but now my needs have changed.

The routine works great, but now I need it to add the descriptions I've added for the layers.

So, how can I grab the info from the descriptions to be added to the XLS file?


;;; Layer2xls.lsp
;;; by Tod Winn 05/05
;;; modified version of layerout.lsp Nov. 2001, Stig Madsen, no rights reserved
;;; changed file to create an XLS file and open it in Excel instead of a TXT
;;; file with NOTEPAD.

;;; LAYEROUT.LSP *
;;; Exports layer information to a simple tabulated text file *
;;; with the following format: *
;;; Name Status Frozen Locked Color LType LWeight Plot *
;;; *

(DEFUN printit (llay / tmp)
(SETQ props (LIST
(CDR (ASSOC 2 llay))
(IF (MINUSP (CDR (ASSOC 62 llay)))
"off"
"on"
)
(IF (= (LOGAND (CDR (ASSOC 70 llay)) 1))
"no"
"yes"
)
(IF (= (LOGAND (CDR (ASSOC 70 llay)) 4))
"no"
"yes"
)
(ABS (CDR (ASSOC 62 llay)))
(STRCASE (CDR (ASSOC 6 llay)) T)
(IF (< (SETQ tmp (CDR (ASSOC 370 llay))) 0)
"default"
(/ tmp 100.0)
)
(IF (= (CDR (ASSOC 290 llay)) 1)
"yes"
"no"
)
)
)
)

(DEFUN c:layer2xls (/) ; (/ lay fn alay layl props ask)
(IF (/= (GETVAR "FILEDIA") 1)
(PROGN
(SETQ fname (GETSTRING "File name: "))
(IF (/= (SUBSTR fname (- (STRLEN fname) 3) 4) ".XLS")
(SETQ fname (STRCAT fname ".XLS"))
)
)
(SETQ fname (GETFILED "Save text file" "" "XLS" 1)) ; "txt" 1))
)
(SETQ fn (OPEN fname "w"))
(SETQ lay (TBLNEXT "LAYER" T))
(WRITE-LINE
(STRCAT "\n" "Name" "\t" "Status" "\t" "Frozen" "\t" "Locked" "\t"
"Color" "\t" "LType" "\t" "LWeight" "\t" "Plot"
)
fn
)
(WHILE lay
(SETQ alay (TBLOBJNAME "LAYER" (CDR (ASSOC 2 lay)))
layl (ENTGET alay)
)
(SETQ props (printit layl))
(FOREACH n props
(PRINC n fn)
(PRINC "\t" fn)
)
(PRINC "\n" fn)
(SETQ lay (TBLNEXT "LAYER"))
)
(IF fn
(CLOSE fn)
)
(INITGET 1 "Y N _Yes No")
(SETQ ask (GETKWORD "Open file in EXCEL? Yes/<No>: "))
(IF (= ask "Yes")
(PROGN
(SETQ
program
"C:\\PROGRAM FILES\\MICROSOFT OFFICE\\OFFICE\\EXCEL.EXE"
)
;;; (SETQ fname (STRCAT "\42" fname "\42")) ;this works-opt B
;;; (SETQ fname (STRCAT (CHR 34) fname (CHR 34))) ;this works-opt C
;;; (STARTAPP program fname) ;this works-opt B & C
;;; (STARTAPP program (STRCAT "\42" fname "\42")) ;this works-opt D
(STARTAPP program (STRCAT (CHR 34) fname (CHR 34)))
)
)
(IF (SETQ tmp (FINDFILE fname))
(PRINC (STRCAT "Layer list saved as " tmp))
(PRINC (STRCAT "Layer list saved as " fname))
)
(PRINC)
)

[T.Willey]

I would go the ActiveX way. I don't see an easy way to get it with plain Lisp. I'm sure it's there, but with ActiveX, it is right there with all the rest of the information you want.

; Property values:
; Application (RO) = #<VLA-OBJECT IAcadApplication 00c2eb8c>
; Description = "This is a test"
; Document (RO) = #<VLA-OBJECT IAcadDocument 2aa06f84>
; Freeze = 0
; Handle (RO) = "E"
; HasExtensionDictionary (RO) = 0
; LayerOn = -1
; Linetype = "CONTINUOUS"
; Lineweight = -3
; Lock = 0
; Name = "0"
; ObjectID (RO) = 2127649904
; ObjectName (RO) = "AcDbLayerTableRecord"
; OwnerID (RO) = 2127649808
; PlotStyleName = "Color_7"
; Plottable = -1
; TrueColor = #<VLA-OBJECT IAcadAcCmColor 2a6212b0>
; Used (RO) = -1
; ViewportDefault = 0
; Methods supported:
; Delete ()
; GetExtensionDictionary ()
; GetXData (3)
; SetXData (2)
T

[fixo]

Give this a try, feel free to change to your suit


;; based on routine Layer-list.lsp by Jimmy Bergmark
;; www.jtbworld.com / http://jtbworld.vze.com
;; Save the layers info to Excel file in the same folder

(defun C:lif (/ adoc aexc alrs awb axss cll col colm
csht head lr_data lw main_cols nwb row sht)
;; Fatty T.O.H. (c) 2006 * all rights removed
(vl-load-com)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object))
)

(setq alrs (vla-get-layers adoc))
(setq main_cols (list "Red" "Yellow" "Green" "Cyan" "Blue" "Magenta" "White"))
(setq head (list "Layer Name" "Status" "Frozen" "Locked"
"Color" "Linetype" "Lineweight" "Plot style name"
"Plottable" "Viewport default" "Description" ))

(vlax-for a alrs

(setq col (vla-get-color a))
(if (< col 8) (setq col (nth (1- col) main_cols)) (setq col (itoa col)))
(setq lw (vla-get-lineweight a))
(if (= lw -3) (setq lw "Default") (setq lw (rtos (/ lw 100.0) 2 2)))
(setq lr_data (cons
(list
(vla-get-name a)
(if (eq :vlax-true (vla-get-layeron a) ) "On" "Off")
(if (eq :vlax-true (vla-get-freeze a) ) "Frozen" "Thawed")
(if (eq :vlax-true (vla-get-lock a) ) "Locked" "Not locked")
col
(vla-get-linetype a)
lw
(vla-get-plotstylename a)
(if (eq :vlax-true (vla-get-plottable a) ) "Plottable" "Not plottable")
(if (eq :vlax-true (vla-get-viewportdefault a) ) "Frozen" "Not frozen")
(vla-get-description a)
) lr_data))
)

(setq lr_data (reverse lr_data))

;;; *** Excel part *** ;;

(setq aexc (vlax-get-or-create-object "Excel.Application")
awb (vlax-get-property aexc "Workbooks")
nwb (vlax-invoke-method awb "Add")
sht (vlax-get-property nwb "Sheets")
csht (vlax-get-property sht "Item" 1)
cll (vlax-get-property csht "Cells")
)
(vlax-put-property csht 'Name "LayerInfo")

(vla-put-visible aexc :vlax-true)
(vlax-put-property aexc 'DisplayAlerts :vlax-true)
(vlax-put-property
(vlax-get-property
(vlax-get-property csht 'Range "1:1")
'Font
)
'Bold
:vlax-true)

(setq row 1 colm 1)
(foreach i head
(vlax-put-property
cll
"Item"
row
colm
(vl-princ-to-string i)
)
(setq colm (1+ colm)))
(setq row (1+ row))
(foreach item lr_data
(setq colm 1)
(foreach i item
(vlax-put-property
cll
"Item"
row
colm
(vl-princ-to-string i)
)
(setq colm (1+ colm)))
(setq row (1+ row)))

(vlax-invoke-method (vlax-get-property csht 'Columns) "AutoFit")

(alert "Be patience!\nFile \"LayerInfo.xls\" would saved automaticaly")
(vlax-invoke-method
nwb
'SaveAs
(strcat (getvar "dwgprefix") (vl-string-subst ".xls" ".dwg" (getvar "dwgname")))
-4143
nil
nil
:vlax-false
:vlax-false
1
2
)
(vlax-invoke-method
nwb
'Close)
(vlax-invoke-method aexc "Quit")

(vlax-release-object cll)
(vlax-release-object csht)
(vlax-release-object sht)
(vlax-release-object nwb)
(vlax-release-object awb)
(vlax-release-object aexc)

(setq cll nil
csht nil
sht nil
nwb nil
awb nil
aexc nil)

(gc)
(gc)
(princ)
)
(prompt "\n\t* *\t======================\t* *\n")
(prompt "\n\t * \tType LIF to execute...\t * \n")
(prompt "\n\t* *\t======================\t* *\n")
(princ)
(princ)


~'J'~

[madcadder]

Give this a try, feel free to change to your suit

~'J'~

Works great! Exactly what I needed.

[fixo]

Glad to help

Happy computing :)

~'J'~