(defun C:Dum ( / *APP doc dwg layers name col ltp lwt pst onoff
frz lock plotTb dat path olist outfile output)
(vl-load-com)
(setq *APP (vlax-get-acad-object)
doc (vla-get-activedocument *APP)
dwg (vla-get-name doc)
path (vla-get-path doc)
layers (vla-get-layers doc)
laylst (tblname "layer") ; have been sorted
)
;;(vlax-for each layers ; have been modified
(foreach each laylst
(setq name (vla-get-name each)
;;col (itoa (dsx-get-color each)) ; see Chapter 25!
col (get-color each) ; have been modified
ltp (vla-get-linetype each)
lwt (itoa (vla-get-lineweight each))
lwt (if (= lwt "-3") "Defualt" lwt) ; have been modified
pst (vla-get-plotstylename each)
onoff (if (= :vlax-true (vla-get-layeron each))
"ON"
"OFF"
)
frz (if (= :vlax-true (vla-get-freeze each))
"FROZEN"
"THAWED"
)
lock (if (= :vlax-true (vla-get-lock each)) ; have been modified
"LOCKED"
"UNLOCKED"
)
pltTb (if (= :vlax-true (vla-get-plottable each)); have been modified
"PRINTABLE"
"UNPRINTABLE"
)
dat (list name col ltp lwt onoff frz lock pst pltTb)
olist (cons dat olist)

)
); vlax-for
(setq olist
(cons
(list "Name" "Color" "Linetype" "Lineweight" "ON" "Freeze" "Lock" "PrintstyelName" "Printalbe")
olist
)
)
(vlax-release-object layers)
(vlax-release-object doc)
(vlax-release-object *APP)
(cond
( olist
(setq outfile (strcat (vl-filename-base dwg) ".htm"))
(setq outfile (strcat path outfile))
(cond
( (setq output (open outfile "w"))
(write-line "" output)
(write-line "" output)
(write-line (strcat "Layer Dump: " dwg) output)
(write-line "" output)
(write-line (strcat "Drawing: " dwg "
") output)
(write-line "

" output)
(foreach layset olist
(write-line "

" output)
(foreach prop layset
(write-line (strcat "

") output) )
(write-line "

" output)
); foreach layer set
(write-line "

" prop "

" output)
(close output)
(setq output nil)
(princ "\nReport finished! Opening in browser...")
(vl-cmdf "_.browser" outfile)
)
( T (princ "\nUnable to open output file.") )
)
)
( T (princ "\nUnable to get layer table information.") )
)
)
;;;get layer color
(defun my-get-color (obj / try) ;???
(cond
( (and
(vlax-property-available-p obj 'color)
(not
(vl-catch-all-error-p
(setq try
(vl-catch-all-apply 'get-color (list obj ))
)
)
)
)
try
)
)
)

(defun get-color (obj / CADver colobj method R G B color)
(setq CADver (getvar "ACADVER"))
(if (> (atoi (substr CADver 1 2)) 15) ;if version higher than R15
(progn
(setq colobj (vla-get-truecolor obj)) ;get layer truecolor
(setq method (vla-get-colorMethod colobj));get colorMethod
(if (= method 194)
(setq R (itoa (vla-get-red colobj))
G (itoa (vla-get-green colobj))
B (itoa (vla-get-blue colobj))
color (strcat R "," G "," B) ;get truecolor RGB
)
(itoa (vla-get-color obj)) ;get layer index color
)
)
(itoa (vla-get-color obj)) ;get layer index color
)
)
;;; get the name list of layer
(defun tblname (tblsym / name namlst)
(setq namlst nil)
(setq namlst (cons (cdr (assoc 2 (tblnext tblsym T))) namlst))
(while (setq name (cdr (assoc 2 (tblnext tblsym))))
(setq namlst (cons name namlst))
)
(setq namlst (reverse (acad_strlsort namlst)))
(mapcar '(lambda (x) (vla-item layers x)) namlst)
)

(c:dum)

Advertisements