Create Complete Xref Report (xref tree, xref name,saved path,xref insertion point, layout, scale, rotation angle, layer and xref amount)


;;; Create Complete Xref Report (xref tree, xref name,saved path,xref insertion point, layout,scale,rotation angle,layer and amount)
;;; about all xref's in a drawing
;;; Created by many authors. Published with great respect to them...
;;; Combined and slightly modified by igal Averbuh 2018

; xreftree.lsp prints xref treeview to file
(princ"\nLoading Command Line XrefTree...")
(defun c:XrefTree ( / GetXrefNesting PrintNestedList outputfile fopen)

(defun *error*(msg)(if fopen (close fopen)))

(defun GetXrefNesting (/ GetXrefInfo tempData tempEnt XrefList NonNestedXrefList NestedXrefList )

(defun GetXrefInfo ( ent / NestList )
(foreach i (member '(102 . "{BLKREFS") (entget ent))
(if (equal (car i) 332)
(progn
(setq NestedList (cons (cdr i) NestedList))
(setq NestList
(cons
(cons
(cdr i)
(GetXrefInfo (cdr i))
)
NestList
)
)
)
)
)
NestList
)
;-------------------------------------

(while (setq tempData (tblnext "block" (not tempData)))
(if (equal (logand (cdr (assoc 70 tempData)) 4) 4)
(progn
(setq tempEnt (tblobjname "block" (cdr (assoc 2 tempData))))
(setq tempEnt (cdr (assoc 330 (entget tempEnt))))
(setq XrefList
(cons
(cons
tempEnt
(GetXrefInfo tempEnt)
)
XrefList
)
)
)
)
)
(foreach i XrefList
(if (not (member (car i) NestedList))
(setq NonNestedXrefList (cons i NonNestedXrefList))
)
)
NonNestedXrefList
)
;------------------------------------------------
(defun PrintNestedList ( lst spc )
(foreach i
(vl-sort lst (function (lambda ( a b ) ( " (cdr(assoc 1 (tblsearch"BLOCK"(cdr (assoc 2 (entget (car i)))))))) fopen)
; (prompt (strcat "\n" spc " Nested xref: " (cdr (assoc 2 (entget (car i))))))
(PrintNestedList (cdr i) (strcat " " spc))
)
)
;-----------------------------------------------------

(setq outputfile (open (setq Path (strcat (getvar 'DwgPrefix) (vl-filename-base (getvar 'DwgName)) "_Xref-Tree.txt")) "w"))

(setq outputfile
(strcat
(getvar 'dwgprefix)
(vl-filename-base (getvar 'dwgname))
"_Xref-Tree.txt"
)
)
(setq fopen (open outputfile "w"))
(write-line (strcat "Drawing Name --> " (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) ".dwg") fopen)
(foreach i
(vl-sort (GetXrefNesting) (function (lambda ( a b ) ( " (cdr(assoc 1 (tblsearch"BLOCK"(cdr(assoc 2 (entget (car i)))))))) fopen)
; (prompt (strcat "\n Main xref: " (cdr (assoc 2 (entget (car i))))))
(PrintNestedList (cdr i) " |-")
)
(close fopen)
(startapp "notepad.exe" outputfile)
(princ)
) ; defun
;(princ"\n...Loaded. To Start Command type: XrefTree.")(princ)

(defun c:PXI ( / GetXrefs XrList Opened Data Path )

(defun GetXrefs (/ tempData tempEnt XrefList)

(while (setq tempData (tblnext "block" (not tempData)))
(if (equal (logand (cdr (assoc 70 tempData)) 4) 4)
(progn
(setq tempEnt (tblobjname "block" (cdr (assoc 2 tempData))))
(setq tempData (entget (cdr (assoc 330 (entget tempEnt)))))
(setq XrefList
(cons
(cons
tempEnt
(
(lambda ( x / InsList NestList )
(foreach i x
(cond
((equal (car i) 331)
(setq InsList (cons (cdr i) InsList))
)
((equal (car i) 332)
(setq NestList (cons (cdr i) NestList))
)
)
)
(list InsList NestList)
)
(member '(102 . "{BLKREFS") tempData)
)
)
XrefList
)
)
)
)
)
XrefList
)
;-----------------------------------------------------
(if (setq XrList (GetXrefs))
(progn
(setq Opened (open (setq Path (strcat (getvar 'DwgPrefix) (vl-filename-base (getvar 'DwgName)) "_Xref-Report.txt")) "w"))
(foreach i XrList
(setq Data (entget (car i)))
(write-line (strcat "Xref name: " (cdr (assoc 2 Data))) Opened)
(write-line (strcat "\tSaved path: " (cdr (assoc 1 Data))) Opened)
(write-line (strcat "\tFound at path: " (findfile (cdr (assoc 1 Data)))) Opened)
(write-line "\tInserted at:" Opened)
(foreach j (cadr i)
(setq Data (entget j))
(write-line (strcat "\t\tLayout: " (cdr (assoc 410 Data))) Opened)
(write-line (strcat "\t\tInsertion point: " (vl-princ-to-string (cdr (assoc 10 Data)))) Opened)
(write-line (strcat "\t\tScale[X Y Z]: " (rtos (cdr (assoc 41 Data))) " " (rtos (cdr (assoc 42 Data))) " " (rtos (cdr (assoc 43 Data)))) Opened)
(write-line (strcat "\t\tRotation: " (rtos (cdr (assoc 50 Data)))) Opened)
(write-line (strcat "\t\tLayer: " (cdr (assoc 8 Data))) Opened)
)
(write-line "\tNested xrefs:" Opened)
(foreach j (caddr i)
(write-line (strcat "\t\t" (cdr (assoc 2 (entget j)))) Opened)
)
)
(close Opened)
(startapp "notepad.exe" Path)
(prompt (strcat "\n Report at: " Path))

)
(prompt "\n No xrefs within drawing.")
)
(princ)
)
(c:XrefTree)
(c:pxi)

;;; Count amount of xrefs in the drawing
;;; Saved from: http://www.theswamp.org/index.php?topic=28062.msg337119#msg337119
;;; original routine by Tim Willey
;;; Slightly modified by igal Averbuh 2018 (added print report to text file and opening output file in notepad)

(defun GetXrefs (/ tempData tempEnt XrefList)

(while (setq tempData (tblnext "block" (not tempData)))
(if (equal (logand (cdr (assoc 70 tempData)) 4) 4)
(progn
(setq tempEnt (tblobjname "block" (cdr (assoc 2 tempData))))
(setq tempData (entget (cdr (assoc 330 (entget tempEnt)))))
(setq XrefList
(cons
(cons
tempEnt
(
(lambda ( x / InsList NestList )
(foreach i x
(cond
((and
(equal (car i) 331)
(entget (cdr i))
)
(setq InsList (cons (cdr i) InsList))
)
((equal (car i) 332)
(setq NestList (cons (cdr i) NestList))
)
)
)
(list InsList NestList)
)
(member '(102 . "{BLKREFS") tempData)
)
)
XrefList
)
)
)
)
)
XrefList
)

(foreach i (GetXrefs)
(princ "\nXref name: ")
(princ (cdr (assoc 2 (entget (car i)))))
(princ "\n Inserted amount: ")
(princ (itoa (length (cadr i))))
(if (caddr i)
(progn
(princ "\n Nested xref names: ")
(foreach j (caddr i)
(princ "\n ")
(princ (cdr (assoc 2 (entget j))))
)
)
)
(princ "\n")
)

(setq Openedd (open (setq Path (strcat (getvar 'DwgPrefix) (vl-filename-base (getvar 'DwgName)) "_Xref-Count.txt")) "w"))

(foreach i (GetXrefs)
(write-line (strcat "\nXref name: ") Openedd)
(write-line (strcat "\t\t" (cdr (assoc 2 (entget (car i))))) Openedd)
(write-line (strcat "\n Inserted amount: ") Openedd)
(write-line (strcat "\t\t" (itoa (length (cadr i)))) Openedd)
(if (caddr i)
(progn
(write-line (strcat "\n Nested xref names: ") Openedd)
(foreach j (caddr i)
(write-line (strcat "\n ") Openedd)
(write-line (strcat "\t\t" (cdr (assoc 2 (entget j)))) Openedd)
)
)
)
(write-line (strcat "\n") Openedd)
)

(close Openedd)
(startapp "notepad.exe" Path)
(prompt (strcat "\n Report at: " Path))

Count amount of xrefs in the drawing


;;; Count amount of xrefs in the drawing
;;; Saved from: http://www.theswamp.org/index.php?topic=28062.msg337119#msg337119
;;; original routine by Tim Willey
;;; Slightly modified by igal Averbuh 2018 (added print report to text file and opening output file in notepad)

(defun GetXrefs (/ tempData tempEnt XrefList)

(while (setq tempData (tblnext "block" (not tempData)))
(if (equal (logand (cdr (assoc 70 tempData)) 4) 4)
(progn
(setq tempEnt (tblobjname "block" (cdr (assoc 2 tempData))))
(setq tempData (entget (cdr (assoc 330 (entget tempEnt)))))
(setq XrefList
(cons
(cons
tempEnt
(
(lambda ( x / InsList NestList )
(foreach i x
(cond
((and
(equal (car i) 331)
(entget (cdr i))
)
(setq InsList (cons (cdr i) InsList))
)
((equal (car i) 332)
(setq NestList (cons (cdr i) NestList))
)
)
)
(list InsList NestList)
)
(member '(102 . "{BLKREFS") tempData)
)
)
XrefList
)
)
)
)
)
XrefList
)

(foreach i (GetXrefs)
(princ "\nXref name: ")
(princ (cdr (assoc 2 (entget (car i)))))
(princ "\n Inserted amount: ")
(princ (itoa (length (cadr i))))
(if (caddr i)
(progn
(princ "\n Nested xref names: ")
(foreach j (caddr i)
(princ "\n ")
(princ (cdr (assoc 2 (entget j))))
)
)
)
(princ "\n")
)

(setq Openedd (open (setq Path (strcat (getvar 'DwgPrefix) (vl-filename-base (getvar 'DwgName)) "_Xref-Count.txt")) "w"))

(foreach i (GetXrefs)
(write-line (strcat "\nXref name: ") Openedd)
(write-line (strcat "\t\t" (cdr (assoc 2 (entget (car i))))) Openedd)
(write-line (strcat "\n Inserted amount: ") Openedd)
(write-line (strcat "\t\t" (itoa (length (cadr i)))) Openedd)
(if (caddr i)
(progn
(write-line (strcat "\n Nested xref names: ") Openedd)
(foreach j (caddr i)
(write-line (strcat "\n ") Openedd)
(write-line (strcat "\t\t" (cdr (assoc 2 (entget j)))) Openedd)
)
)
)
(write-line (strcat "\n") Openedd)
)

(close Openedd)
(startapp "notepad.exe" Path)
(prompt (strcat "\n Report at: " Path))

Print Xref/Block Nesting


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Print Xref/Block Nesting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; http://www.theswamp.org/index.php?topic=28062.msg337119#msg337119
;;; original routine by Tim Willey
;;; major editing by Marko Ribar
;;; Prints nested block tree to command line, no matter how deep the nesting.
;;; edited by Gary Fowler
;;; Added output file with project header and routine progress bar and paths info
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:PIT ( / Flatten xrefs-list ARCH:DATE2 mainfilter filter nestedblockcount FilterNestedBlocks filternested GetBlockNesting n kk k datestring FileName opened PrintNestedList projectDesc projectName ACET:UI-PROGRESS-FACTOR )

(vl-load-com)

(defun Flatten ( l )
(if (atom l) (list l)
(append (Flatten (car l)) (if (cdr l) (Flatten (cdr l))))
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xrefs-list nil
(write-line (strcat "\n List Of Saved Xref Paths:") opened)
(write-line "----------------------------------------------------------------------" opened)
(vlax-for
objFileDep
(vla-get-filedependencies
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (= "Acad:XRef" (vla-get-feature objFileDep))
(write-line
(strcat " " (vla-get-fullfilename objFileDep))
opened
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:DATE2 (/ DATST MON DAY YEAR HRS MON2 NHRS XTR)
(setq DATST (rtos (getvar "CDATE") 2 16)
MON (substr DATST 5 2)
DAY (substr DATST 7 2)
YEAR (substr DATST 1 4)
HRS (atoi (substr DATST 10 2))
)
(cond
( (= MON "01") (setq MON2 "January") )
( (= MON "02") (setq MON2 "Feburary") )
( (= MON "03") (setq MON2 "March") )
( (= MON "04") (setq MON2 "April") )
( (= MON "05") (setq MON2 "May") )
( (= MON "06") (setq MON2 "June") )
( (= MON "07") (setq MON2 "July") )
( (= MON "08") (setq MON2 "August") )
( (= MON "09") (setq MON2 "September") )
( (= MON "10") (setq MON2 "October") )
( (= MON "11") (setq MON2 "November") )
( (= MON "12") (setq MON2 "December") )
)
(cond
( (= HRS 00) (setq NHRS (itoa (+ HRS 12))) (setq XTR "a.m.") )
( ( HRS 12) (setq NHRS (itoa (- HRS 12))) (setq XTR "p.m.") )
)
(setq datestring (strcat MON2 " " DAY ", " YEAR " " NHRS ":" (substr DATST 12 2) " " XTR))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq mainfilter
(getstring
T
"\n* Input prefix filter for Main Blocks: [*] "
)
)
(if (= mainfilter "")
(setq mainfilter "*")
)
(setq filter
(getstring T
"\n* Input prefix filter for Nested Blocks: [*] "
)
)
(if (= filter "")
(setq filter "*")
)
(prompt "* Please Wait while the Program is Running...")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nestedblockcount ( mainname nestedname / bl item n )
(setq bl (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for item bl
(if (= (vla-get-name item) mainname)
(progn
(setq n 0)
(vlax-for b item
(if (= (vl-catch-all-apply 'vla-get-EffectiveName (list b)) nestedname)
(setq n (1+ n))
)
)
)
)
)
n
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun FilterNestedBlocks ( lst mainfilter filter / ifillst inewlst newlst )
(foreach i lst
(if (and (atom (car i)) (wcmatch (strcase (cdr (assoc 2 (entget (car i))))) (strcase mainfilter)))
(progn
(if (listp (cdr i))
(progn
(setq ifillst (filternested (cdr i) filter))
(setq inewlst (cons (car i) ifillst))
(setq newlst (cons inewlst newlst))
)
(setq newlst (cons i newlst))
)
)
)
)
(reverse newlst)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun filternested ( lst filter / newlst ii )
(foreach i lst
(setq ii i)
(if (not (and (atom (car i)) (wcmatch (strcase (cdr (assoc 2 (entget (car i))))) (strcase filter))))
(setq ii nil)
)
(cond
( (if (and (listp (cdr i)) (member (car i) ii)) (filternested (cdr i) filter) (setq ii nil)) )
( (and (atom (cdr i)) (not (eq (cdr i) nil)))
nil
)
( (eq (cdr i) nil)
nil
)
)
(setq newlst (cons ii newlst))
)
(reverse newlst)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GetBlockNesting ( / checknestinserts GetBlockInfo tempData def BlockList objBlocks )

(defun checknestinserts ( def / f )
(vlax-for obj def
(if (= (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))) "INSERT")
(setq f t)
)
)
f
)

(defun GetBlockInfo ( def / uniqueref refl NestList )

(defun uniqueref ( l )
(if l (cons (car l) (uniqueref (vl-remove-if '(lambda ( x ) (= (vla-get-name x) (vla-get-name (car l)))) l))))
)

(vlax-for obj def
(if (= (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))) "INSERT")
(setq refl (cons obj refl))
)
)
(setq refl (reverse refl))
(setq refl (uniqueref refl))
(foreach obj refl
(if (not (checknestinserts (vla-item objBlocks (vla-get-name obj))))
(setq NestList (cons (list (vlax-vla-object->ename obj)) NestList))
(setq NestList (cons (cons (vlax-vla-object->ename obj) (GetBlockInfo (vla-item objBlocks (vla-get-name obj)))) NestList))
)
)
NestList
)

(while (setq tempData (tblnext "BLOCK" (not tempData)))
(if (assoc 102 (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" (cdr (assoc 2 tempData))))))))
(progn
(setq def (vla-item (setq objBlocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (cdr (assoc 2 tempData))))
(setq names nil name nil)
(setq BlockList
(cons
(cons
(vlax-vla-object->ename def)
(GetBlockInfo def)
)
BlockList
)
)
)
)
)
BlockList
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq n 1)
(ACET-UI-PROGRESS-INIT
"Please Wait while the Program is Running"
(length
(Flatten
(progn
(setq kk nil)
(foreach k (vl-remove nil (FilterNestedBlocks (GetBlockNesting) mainfilter filter))
(setq k (vl-remove nil k))
(setq kk (cons k kk))
)
(reverse kk)
)
)
)
)
(ARCH:DATE2)
(setq FileName (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
(setq opened (open (strcat (getvar "dwgprefix") FileName " PrintNesting.txt") "w"))
(write-line
"----------------------------------------------------------------------"
opened
)
(write-line (strcat " Directory is: [" (getvar "dwgprefix") FileName "]") opened)
(write-line (strcat " " datestring) opened)
(write-line
"----------------------------------------------------------------------"
opened
)

(defun PrintNestedList ( lst spc mainname / lstn k kk )
(foreach i (setq lstn (vl-sort lst (function (lambda ( a b ) (vla-object (car i))))))
(write-line
(strcat "" spc " Nested xref: " (cdr (assoc 2 (entget (car i)))) " - " (itoa (nestedblockcount mainname (cdr (assoc 2 (entget (car i)))))))
opened
)
(write-line
(strcat "" spc " Nested block: " (cdr (assoc 2 (entget (car i)))) " - " (itoa (nestedblockcount mainname (cdr (assoc 2 (entget (car i)))))))
opened
)
)
(prompt (strcat "\n" spc " Nested block: nil"))
)
(PrintNestedList
(if (cdr i)
(cdr i)
nil
)
(strcat " " spc)
(cdr (assoc 2 (entget (car i))))
)
(ACET-UI-PROGRESS-SAFE n)
(setq n (1+ n))
)
(setq k 0)
(foreach i lstn
(setq k (+ k (nestedblockcount mainname (cdr (assoc 2 (entget (car i)))))))
)
(if lstn (write-line (strcat spc " *** Total count per branch : " (itoa k) " *** ") opened))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(foreach i
(vl-sort
(progn
(setq kk nil)
(foreach k (vl-remove nil (FilterNestedBlocks (GetBlockNesting) mainfilter filter))
(setq k (vl-remove nil k))
(setq kk (cons k kk))
)
(reverse kk)
)
(function
(lambda ( a b )
(vla-object (car i))))))
(write-line
(strcat "\n [ ] Main xref: " (cdr (assoc 2 (entget (car i)))) " - " (itoa (sslength (ssget "_A" (list '(0 . "INSERT") (assoc 2 (entget (car i))) (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))))
opened
)
(write-line
(strcat "\n [ ] Main block: " (cdr (assoc 2 (entget (car i)))) " - " (itoa (sslength (ssget "_A" (list '(0 . "INSERT") (assoc 2 (entget (car i))) (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))))
opened
)
)
(ACET-UI-PROGRESS-SAFE n)
(setq n (1+ n))
(PrintNestedList
(if (and (/= (cadr i) nil) (cdr i))
(vl-remove nil (cdr i))
)
" >"
(cdr (assoc 2 (entget (car i))))
)
)
)
)

(if Opened
(close Opened)
)
(startapp "notepad.exe"
(strcat (getvar "dwgprefix")
FileName
" PrintNesting.txt"
)
)
(ACET-UI-PROGRESS-DONE)
(princ)
)
(c:pit)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Area Report from 2 Numeric Texts or 2 Linear Dimensions or 2 Numeric Block Attributes as txt file with text string in format A x B .. = Area (cm²)


;; Area Report from 2 Numeric Texts or 2 Linear Dimensions or 2 Numeric Block Attributes as txt file with text string in format A x B .. = Area (cm²)
;; Created by Dlanor 2018 (thanks to Tim Willey) slightly modified by Igal Averbuh 2018 (add changed to multiply)
;; Saved from: http://www.theswamp.org/index.php?topic=54104.0

;; PLEASE READ FIRST
;; Error checking is basic. The Sub (rh:get_num) only checks if the string is empty having removed all digits
;; the decimal point and any spaces. This is the minimum to allow atof. Integers will be parsed to reals
;;
;; You can select Dimensions, Attributes or Text provided the selected item ONLY contains Numbers.
;; MText may fail due to the formatting contained within the text string.
;; An allowance has been made for spaces. Text containing spaces should parse.
;; Select entities individually. If an object is not allowed and alert box will inform you why
;; but you can continue to select. To end the entity selection left click on an empty area of the screen
;; This will produce an empty entity selection and exit the selection loop.
;; Be aware discrepancies may arise due to rounding required.
;; If you need to alter the number accuracy or Report file name please change
;; the first or second line in the first setq statement as required
;; I've included a "shortcut" to start the lisp (defun c:ax() (c:addtxts)). If you change the main routine name
;; you will need to update the "shortcut" as well
;; so type "addtxts" or "ax" to start
;;
(vl-load-com)

(defun rh:get_num ( txt )
(if (= (vl-string-trim ".0123456789 " txt) "")
(setq txt (atof txt))
(setq txt '())
);end_if
);end_defun

(defun c:ax () (c:addtxts))

(defun c:addtxts ( / *error* ent e_len obj txt_num t_lst xport_str file_name f_ptr m_txt o_lst)

(defun *error* ( msg )
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
(princ)
);_end_*error*_defun

(setq acc 1 ;<<==== Alter this to change the number of decimal places for the report
file_name (strcat (getvar "dwgprefix") "Area Export Report.txt") ;vla-object ent))
(cond ( (or (= (vla-get-objectname obj) "AcDbAlignedDimension") ;Aligned Dims
(= (vla-get-objectname obj) "AcDbRotatedDimension") ;Linear Dims
(= (vla-get-objectname obj) "AcDbArcDimension") ;ArcLength Dims
);end_or
(if (/= (vla-get-textoverride obj) "")
(setq txt_num (rh:get_num (vla-get-textoverride obj)))
(setq txt_num (vla-get-measurement obj))
);end_if
(setq m_txt "Overridden Dimension Text")
);end_cond1
( (or (= (vla-get-objectname obj) "AcDbText") (= (vla-get-objectname obj) "AcDbAttribute"))
(setq txt_num (rh:get_num (vla-get-textstring obj))
m_txt (if (= (vla-get-objectname obj) "AcDbAttribute")
"Attribute"
"Text"
);end_if
);end_setq
);end_cond2
(t
(alert "Not an Allowed Dimension, Text or Attribute")
(setq ent nil)
);end_cond3
);end_cond

(if (numberp txt_num)
(progn
(redraw ent 3)
(setq t_lst (cons txt_num t_lst)
o_lst (cons ent o_lst)
);end_setq
(if (= (strlen xport_str) 0)
(setq xport_str (strcat xport_str (rtos txt_num 2 acc)))
(setq xport_str (strcat xport_str " x " (rtos txt_num 2 acc)))
);end_if
);end_progn
(if ent (alert (strcat "Selected " m_txt " is NOT a number")))
);end_if
);end_progn
);end_if
);end_while
(if (> (length t_lst) 0)
(progn
(setq xport_str (strcat xport_str " = " (rtos (apply '* t_lst) 2 acc) " cm²")
f_ptr (open file_name "a")
);end_setq
(write-line " " f_ptr)
(write-line "Area =" f_ptr)
(princ xport_str f_ptr)
(close f_ptr)
(startapp "notepad.exe" file_name)
);end_progn
);end_if
(mapcar '(lambda (x) (redraw x 4)) o_lst)
(princ)
);end_defun
(princ)
(c:ax)

Area Report from 2 Numeric Texts or 2 Linear Dimensions or 2 Numeric Block Attributes as txt file with text string in format A x B .. = Area (m²)


;; Area Report from 2 Numeric Texts or 2 Linear Dimensions or 2 Numeric Block Attributes as txt file with text string in format A x B .. = Area (m²)
;; Created by Dlanor 2018 (thanks to Tim Willey) slightly modified by Igal Averbuh 2018 (add changed to multiply)
;; Saved from: http://www.theswamp.org/index.php?topic=54104.0

;; PLEASE READ FIRST
;; Error checking is basic. The Sub (rh:get_num) only checks if the string is empty having removed all digits
;; the decimal point and any spaces. This is the minimum to allow atof. Integers will be parsed to reals
;;
;; You can select Dimensions, Attributes or Text provided the selected item ONLY contains Numbers.
;; MText may fail due to the formatting contained within the text string.
;; An allowance has been made for spaces. Text containing spaces should parse.
;; Select entities individually. If an object is not allowed and alert box will inform you why
;; but you can continue to select. To end the entity selection left click on an empty area of the screen
;; This will produce an empty entity selection and exit the selection loop.
;; Be aware discrepancies may arise due to rounding required.
;; If you need to alter the number accuracy or Report file name please change
;; the first or second line in the first setq statement as required
;; I've included a "shortcut" to start the lisp (defun c:ax() (c:addtxts)). If you change the main routine name
;; you will need to update the "shortcut" as well
;; so type "addtxts" or "ax" to start
;;
(vl-load-com)

(defun rh:get_num ( txt )
(if (= (vl-string-trim ".0123456789 " txt) "")
(setq txt (atof txt))
(setq txt '())
);end_if
);end_defun

(defun c:ax () (c:addtxts))

(defun c:addtxts ( / *error* ent e_len obj txt_num t_lst xport_str file_name f_ptr m_txt o_lst)

(defun *error* ( msg )
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
(princ)
);_end_*error*_defun

(setq acc 1 ;<<==== Alter this to change the number of decimal places for the report
file_name (strcat (getvar "dwgprefix") "Area Export Report.txt") ;vla-object ent))
(cond ( (or (= (vla-get-objectname obj) "AcDbAlignedDimension") ;Aligned Dims
(= (vla-get-objectname obj) "AcDbRotatedDimension") ;Linear Dims
(= (vla-get-objectname obj) "AcDbArcDimension") ;ArcLength Dims
);end_or
(if (/= (vla-get-textoverride obj) "")
(setq txt_num (rh:get_num (vla-get-textoverride obj)))
(setq txt_num (vla-get-measurement obj))
);end_if
(setq m_txt "Overridden Dimension Text")
);end_cond1
( (or (= (vla-get-objectname obj) "AcDbText") (= (vla-get-objectname obj) "AcDbAttribute"))
(setq txt_num (rh:get_num (vla-get-textstring obj))
m_txt (if (= (vla-get-objectname obj) "AcDbAttribute")
"Attribute"
"Text"
);end_if
);end_setq
);end_cond2
(t
(alert "Not an Allowed Dimension, Text or Attribute")
(setq ent nil)
);end_cond3
);end_cond

(if (numberp txt_num)
(progn
(redraw ent 3)
(setq t_lst (cons txt_num t_lst)
o_lst (cons ent o_lst)
);end_setq
(if (= (strlen xport_str) 0)
(setq xport_str (strcat xport_str (rtos txt_num 2 acc)))
(setq xport_str (strcat xport_str " x " (rtos txt_num 2 acc)))
);end_if
);end_progn
(if ent (alert (strcat "Selected " m_txt " is NOT a number")))
);end_if
);end_progn
);end_if
);end_while
(if (> (length t_lst) 0)
(progn
(setq xport_str (strcat xport_str " = " (rtos (apply '* t_lst) 2 acc) " m²")
f_ptr (open file_name "a")
);end_setq
(write-line " " f_ptr)
(write-line "Area =" f_ptr)
(princ xport_str f_ptr)
(close f_ptr)
(startapp "notepad.exe" file_name)
);end_progn
);end_if
(mapcar '(lambda (x) (redraw x 4)) o_lst)
(princ)
);end_defun
(princ)
(c:ax)

Numeric Texts, Linear Dimensions and numeric block Attributes Sum Report as txt file with text string in format A+B+C+.. = Sum


;; Numeric Texts, Linear Dimensions and Numeric Block Attributes Sum Report as txt file with text string in format A+B+C+.. = Sum
;; Created by Dlanor 2018 (thanks to Tim Willey)
;; Saved from: http://www.theswamp.org/index.php?topic=54104.0

;; PLEASE READ FIRST
;; Error checking is basic. The Sub (rh:get_num) only checks if the string is empty having removed all digits
;; the decimal point and any spaces. This is the minimum to allow atof. Integers will be parsed to reals
;;
;; You can select Dimensions, Attributes or Text provided the selected item ONLY contains Numbers.
;; MText may fail due to the formatting contained within the text string.
;; An allowance has been made for spaces. Text containing spaces should parse.
;; Select entities individually. If an object is not allowed and alert box will inform you why
;; but you can continue to select. To end the entity selection left click on an empty area of the screen
;; This will produce an empty entity selection and exit the selection loop.
;; Be aware discrepancies may arise due to rounding required.
;; If you need to alter the number accuracy or Report file name please change
;; the first or second line in the first setq statement as required
;; I've included a "shortcut" to start the lisp (defun c:tx() (c:addtxts)). If you change the main routine name
;; you will need to update the "shortcut" as well
;; so type "addtxts" or "tx" to start
;;
(vl-load-com)

(defun rh:get_num ( txt )
(if (= (vl-string-trim ".0123456789 " txt) "")
(setq txt (atof txt))
(setq txt '())
);end_if
);end_defun

(defun c:tx () (c:addtxts))

(defun c:addtxts ( / *error* ent e_len obj txt_num t_lst xport_str file_name f_ptr m_txt o_lst)

(defun *error* ( msg )
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
(princ)
);_end_*error*_defun

(setq acc 1 ;<<==== Alter this to change the number of decimal places for the report
file_name (strcat (getvar "dwgprefix") "Dimension Export Report.txt") ;< e_len 2)
(setq ent (car (nth (1- e_len) ent)))
(setq ent (car ent))
);end_if
(setq obj (vlax-ename->vla-object ent))
(cond ( (or (= (vla-get-objectname obj) "AcDbAlignedDimension") ;Aligned Dims
(= (vla-get-objectname obj) "AcDbRotatedDimension") ;Linear Dims
(= (vla-get-objectname obj) "AcDbArcDimension") ;ArcLength Dims
);end_or
(if (/= (vla-get-textoverride obj) "")
(setq txt_num (rh:get_num (vla-get-textoverride obj)))
(setq txt_num (vla-get-measurement obj))
);end_if
(setq m_txt "Overridden Dimension Text")
);end_cond1
( (or (= (vla-get-objectname obj) "AcDbText") (= (vla-get-objectname obj) "AcDbAttribute"))
(setq txt_num (rh:get_num (vla-get-textstring obj))
m_txt (if (= (vla-get-objectname obj) "AcDbAttribute")
"Attribute"
"Text"
);end_if
);end_setq
);end_cond2
(t
(alert "Not an Allowed Dimension, Text or Attribute")
(setq ent nil)
);end_cond3
);end_cond

(if (numberp txt_num)
(progn
(redraw ent 3)
(setq t_lst (cons txt_num t_lst)
o_lst (cons ent o_lst)
);end_setq
(if (= (strlen xport_str) 0)
(setq xport_str (strcat xport_str (rtos txt_num 2 acc)))
(setq xport_str (strcat xport_str " + " (rtos txt_num 2 acc)))
);end_if
);end_progn
(if ent (alert (strcat "Selected " m_txt " is NOT a number")))
);end_if
);end_progn
);end_if
);end_while
(if (> (length t_lst) 0)
(progn
(setq xport_str (strcat xport_str " = " (rtos (apply '+ t_lst) 2 acc))
f_ptr (open file_name "a")
);end_setq
(write-line " " f_ptr)
(princ xport_str f_ptr)
(close f_ptr)
(startapp "notepad.exe" file_name)
);end_progn
);end_if
(mapcar '(lambda (x) (redraw x 4)) o_lst)
(princ)
);end_defun
(princ)
(c:tx)

Quick Create wblock from Polyline Selection with base point 0,0,0 and place it in a drawing directory (No need to specify name and insertion point of wblock)


;;; Quick Create wblock from Polyline Selection with base point 0,0,0 and place it in a drawing directory
;;; No need to specify name and insertion point of wblock
;;; Special thanks to Alan J. Thompson and Lee Mak

;;; Combined by Igal Averbuh 2017 (inspired by some ideas from http://www.cadtutor.net/forum/)

;;; Lee Mak Quick Wblock Creator
;;; 'Convert' current selection set to selection set required by the Wblock method)
;;; Saved from: http://www.cadtutor.net/forum/showthread.php?91674-Make-selection-set-active

(defun c:wb ( / doc idx lst sel ssc vsl )
(if (setq sel (ssget "P"))
(progn
(repeat (setq idx (sslength sel))
(setq lst (cons (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst))
)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
ssc (vla-get-selectionsets doc)
vsl (vla-add ssc (uniqueitem ssc "mywb"))
)
(vla-additems vsl
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst))))
lst
)
)
)
(vla-wblock doc
(vl-filename-mktemp
(vl-filename-base (getvar 'dwgname))
(getvar 'dwgprefix)
".dwg"
)
vsl
)
(vla-delete vsl)
)
)
(princ)
)

(defun uniqueitem ( col key / int rtn )
(setq int 0)
(while
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item
(list col (setq rtn (strcat key (itoa (setq int (1+ int))))))
)
)
)
)
rtn
)

(vl-load-com) (princ)

(defun c:swc (/ _addgroup _pac add e i ss temp)
;; Select Objects Within/Crossing Curve
;; Alan J. Thompson, 03.31.11
;; Slightly modified by Igal Averbuh 2017 (added option for splines)
;; RJP simplified & added groups 02.22.2017
(vl-load-com)
(defun _pac (e / l v d lst)
(setq d (- (setq v (/ (setq l (vlax-curve-getdistatparam e (vlax-curve-getendparam e))) 500.))))
(while (< (setq d (+ d v)) l) (setq lst (cons (vlax-curve-getpointatdist e d) lst)))
)
(defun _addgroup (listofobjects / grp grps name)
;; Check that all items in the list are vla-objects
(if (and (vl-every '(lambda (x) (eq (type x) 'vla-object)) listofobjects)
(setq grps (vla-get-groups (vla-get-activedocument (vlax-get-acad-object))))
)
(progn (setq grp (vla-add grps "*"))
(vlax-invoke grp 'appenditems listofobjects)
listofobjects
)
)
)
(initget 0 "Crossing Within")
(setq *swc:opt*
(cond ((getkword (strcat "\nSpecify selection method witin curve [Crossing/Within] : "
)
)
)
(*swc:opt*)
)
)
; (princ "\nSelect closed curves to select object(s) within: ")
(if (setq add (ssadd)
ss (ssget "L" )
)
(progn
(repeat (setq i (sslength ss))
;; Must be visible on screen for point selection to work
(if (setq temp (ssget (if (eq *swc:opt* "Crossing")
"_CP"
"_WP"
)
(_pac (setq e (ssname ss (setq i (1- i)))))
)
)
(progn
;; Remove boundary from selection so it won't get grouped
(ssdel e temp)
;; Delete boundary
(entdel e)
;; Group objects
(_addgroup
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex temp))))
)
;; Highlight selection
(sssetfirst nil temp)
)
)
)
)
)
(princ)
)

(defun C:WPS ()
(setvar "osmode" 16384)

(command "_.pline")
(while (> (getvar "CmdActive") 0)
(command pause)
)
(c:swc)
(c:wb)
(command "_.erase" "p" "")
(princ)
)

Quick Create wblock from Lasso Selection with base point 0,0,0 and place it in a drawing directory (No need to specify name and insertion point of wblock)


;;; Quick Create wblock from Lasso Selection with base point 0,0,0 and place it in a drawing directory
;;; No need to specify name and insertion point of wblock
;;; Special thanks to Alan J. Thompson and Lee Mak

;;; Combined by Igal Averbuh 2017 (inspired by some ideas from http://www.cadtutor.net/forum/)

;;; Lee Mak Quick Wblock Creator
;;; 'Convert' current selection set to selection set required by the Wblock method)
;;; Saved from: http://www.cadtutor.net/forum/showthread.php?91674-Make-selection-set-active

(defun c:wb ( / doc idx lst sel ssc vsl )
(if (setq sel (ssget "P"))
(progn
(repeat (setq idx (sslength sel))
(setq lst (cons (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst))
)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
ssc (vla-get-selectionsets doc)
vsl (vla-add ssc (uniqueitem ssc "mywb"))
)
(vla-additems vsl
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst))))
lst
)
)
)
(vla-wblock doc
(vl-filename-mktemp
(vl-filename-base (getvar 'dwgname))
(getvar 'dwgprefix)
".dwg"
)
vsl
)
(vla-delete vsl)
)
)
(princ)
)

(defun uniqueitem ( col key / int rtn )
(setq int 0)
(while
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item
(list col (setq rtn (strcat key (itoa (setq int (1+ int))))))
)
)
)
)
rtn
)

(vl-load-com) (princ)

(defun c:swc (/ _addgroup _pac add e i ss temp)
;; Select Objects Within/Crossing Curve
;; Alan J. Thompson, 03.31.11
;; Slightly modified by Igal Averbuh 2017 (added option for splines)
;; RJP simplified & added groups 02.22.2017
(vl-load-com)
(defun _pac (e / l v d lst)
(setq d (- (setq v (/ (setq l (vlax-curve-getdistatparam e (vlax-curve-getendparam e))) 500.))))
(while (< (setq d (+ d v)) l) (setq lst (cons (vlax-curve-getpointatdist e d) lst)))
)
(defun _addgroup (listofobjects / grp grps name)
;; Check that all items in the list are vla-objects
(if (and (vl-every '(lambda (x) (eq (type x) 'vla-object)) listofobjects)
(setq grps (vla-get-groups (vla-get-activedocument (vlax-get-acad-object))))
)
(progn (setq grp (vla-add grps "*"))
(vlax-invoke grp 'appenditems listofobjects)
listofobjects
)
)
)
(initget 0 "Crossing Within")
(setq *swc:opt*
(cond ((getkword (strcat "\nSpecify selection method witin curve [Crossing/Within] : "
)
)
)
(*swc:opt*)
)
)
; (princ "\nSelect closed curves to select object(s) within: ")
(if (setq add (ssadd)
ss (ssget "L" )
)
(progn
(repeat (setq i (sslength ss))
;; Must be visible on screen for point selection to work
(if (setq temp (ssget (if (eq *swc:opt* "Crossing")
"_CP"
"_WP"
)
(_pac (setq e (ssname ss (setq i (1- i)))))
)
)
(progn
;; Remove boundary from selection so it won't get grouped
(ssdel e temp)
;; Delete boundary
(entdel e)
;; Group objects
(_addgroup
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex temp))))
)
;; Highlight selection
(sssetfirst nil temp)
)
)
)
)
)
(princ)
)

(defun C:WAS ()
(setvar "osmode" 16384)

(command "_.spline")
(while (> (getvar "CmdActive") 0)
(command pause)
)
(c:swc)
(c:wb)
(command "_.erase" "p" "")
(princ)
)

ETABLE – Send entity properties into a table (Adapted to 2D drawings (Z – coordinate disabled). Accuracy reduced to 0.00)


;;;--- ETABLE - Send entity properties into a table.

;;; Need to disable WinHeb application in order to make routine work properly

;;; Modified by Igal Averbuh 2016 (Adapted to 2D drawings (Z - coordinate disabled). Accuracy reduced to 0.00)

;;;--- Copyright 2007 by JefferyPSanders.com. All rights reserved.
;;;
;;; This program was created to extract data from entities and send
;;; them to an autocad table entity.

;;; The types of entities to be selected are ARC, ATTRIB, CIRCLE,
;;; ELLIPSE, IMAGE, INSERT (Block), LINE, LWPOLYLINE, MLINE,
;;; MTEXT, POINT, POLYLINE, SOLID, TEXT, TRACE, and XLINE.

;;; Revisions:
;;;
;;; 12/6/07 - Solved problem with program crashing with variable txtSz.
;;; 12/6/07 - Added the ability to save the last used settings
;;;
;;;

;;; Comments:
;;;
;;; 12/5/07 - AutoCAD 2005 crashes at the vla-addtable statement (unresolved)
;;; 12/6/07 - Add ability to save defaults (resolved)
;;; 9/12/13 - Added multi-language support

;;;--- Function to strip commas from a string

(defun stripCommas(a)
(setq cnt 1)
(while (< cnt (strlen a))
(setq ch(substr a cnt 1))
(if(= ch ",")
(setq a
(strcat
(substr a 1 (- cnt 1))
(substr a (+ cnt 1))
)
)
(setq cnt(+ cnt 1))
)
)
a
)

;;;--- Function to return an arc length

(defun getArcLen(rad sAng eAng)
(if ( lang (* pi 0.5))(< lang (* pi 1.5)))
(setq side "Left")
(setq side "Right")
)

;;;--- Find the up down location of the box
(if(<= lang pi)
(setq upDwn "Top")
(setq upDwn "Bot")
)

;;;--- Calculate the box points based on location
(if(and(= side "Left")(= upDwn "Top"))
(setq pta txtPt ptb (polar pta (* pi 0.5) boxHeight)
ptc (polar ptb pi boxWidth)
ptd (polar pta pi boxWidth)
txtPt ptd
)
)
(if(and(= side "Left")(= upDwn "Bot"))
(setq pta txtPt ptb (polar pta pi boxWidth)
ptc (polar ptb (* pi 1.5) boxHeight)
ptd (polar ptc 0 boxWidth)
txtPt ptc
)
)
(if(and(= side "Right")(= upDwn "Top"))
(setq pta txtPt ptb (polar pta 0 boxWidth)
ptc (polar ptb (* pi 0.5) boxHeight)
ptd (polar ptc pi boxWidth)
)
)
(if(and(= side "Right")(= upDwn "Bot"))
(setq pta txtPt ptb (polar pta (* pi 1.5) boxHeight)
ptc (polar ptb 0 boxWidth)
ptd (polar pta 0 boxWidth)
txtPt ptb
)
)

;;;--- Draw a leader and box around the text label
(command "_pline" (polar dotPt lang (/ txtSz 2.0)) "w" 0 0 pta ptb ptc ptd pta "")

;;;--- Get the current text style
(setq csty(getvar "textstyle"))

;;;--- See if the text style has a preset height
(if(= 0 (cdr(assoc 40(tblsearch "style" csty))))

;;;--- Insert the text with a height parameter
(command "_text" (polar txtPt (* pi 0.25) (/ txtSz 4.0)) (getvar "textsize") 0 label)

;;;--- Else, Insert the text without a height parameter
(command "_text" (polar txtPt (* pi 0.25) (/ txtSz 4.0)) 0 label)
)

;;;--- Reset layer and osnaps
(setvar "clayer" oldLay)
(setvar "osmode" oldSnap)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; ;;;
;;;--- Functions to get entity types ;;;
;;; ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;--- ARC DATA

(defun getArcData(/ eset hdrStr en enlist entLyr entPt entRad entDia entLty entClr dstr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "ARC"))
(setq eset(ssget "X" (list (cons 0 "ARC"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog5 "1")(setq hdrStr (append hdrStr (list "Center X" "Center Y"))))
(if(= tog10 "1")(setq hdrStr (append hdrStr (list "LineType"))))
(if(= tog11 "1")(setq hdrStr (append hdrStr (list "Radius"))))
(if(= tog12 "1")(setq hdrStr (append hdrStr (list "Diameter"))))
(if(= tog18 "1")(setq hdrStr (append hdrStr (list "Length"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))
(setq entPt(cdr(assoc 10 enlist)))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2) (rtos(caddr entPt)2 2)))
(setq entRad(rtos(cdr(assoc 40 enlist))2 2))
(setq entDia(rtos(* 2 (cdr(assoc 40 enlist)))2 2))
(setq entLen(getArcLen (cdr(assoc 40 enlist))(cdr(assoc 50 enlist))(cdr(assoc 51 enlist))))
(if(not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)
(if(cdr(assoc 6 enlist))
(setq entLty(cdr(assoc 6 enlist)))
(setq entLty "BYLAYER")
)
(if(cdr(assoc 62 enlist))
(setq entClr(cdr(assoc 62 enlist)))
(setq entClr "BYLAYER")
)
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))

(setq stpt(polar entPt (cdr(assoc 50 enlist)) (distof entRad)))
(setq edpt(polar entPt (cdr(assoc 51 enlist)) (distof entRad)))
(if (not c:cal)(arxload "geomcal"))
(setq myAng (cal "ang(entPt,stpt,edpt)"))
(setq myAng(+ (angle entPt stpt) (* pi (/ (/ myAng 2.0) 180.0))))
(setq newPt(polar entPt myAng (distof entRad)))

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
newPt ; arrow point
(polar newPt (angle entPt newpt) (* 4.0 (getvar "textsize"))) ; text point
)
)

(setq dStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum))))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr))))
(if(= tog5 "1")(setq dStr (append dStr entPtSTr)))
(if(= tog10 "1")(setq dStr (append dStr (list entLty))))
(if(= tog11 "1")(setq dStr (append dStr (list entRad))))
(if(= tog12 "1")(setq dStr (append dStr (list entDia))))
(if(= tog18 "1")(setq dStr (append dStr (list entLen))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- ATTRIBUTE DATA

(defun getAttData(/ eset hdrStr dataList blkCntr en enlist blkType entName entPoint entRot
entX entY entZ entLay attTag attVal entSty entClr dStr group66)
;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "INSERT"))
(setq eset(ssget "X" (list (cons 0 "INSERT"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog1 "1")(setq hdrStr (append hdrStr (list "Name"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog4 "1")(setq hdrStr (append hdrStr (list "Insertion X" "Insertion Y"))))
(if(= tog7 "1")(setq hdrStr (append hdrStr (list "Tag"))))
(if(= tog8 "1")(setq hdrStr (append hdrStr (list "Text Value"))))
(if(= tog9 "1")(setq hdrStr (append hdrStr (list "Style"))))
(if(= tog16 "1")(setq hdrStr (append hdrStr (list "Rotation"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up some counters
(setq blkCntr 0 cntr 0)

;;;--- Loop through each entity
(while (< blkCntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset blkCntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Check to see if the block's attribute flag is set
(if(cdr(assoc 66 enlist))
(progn

;;;--- Get the entity name
(setq en(entnext en))

;;;--- Get the entity dxf group codes
(setq enlist(entget en))

;;;--- Get the type of block
(setq blkType (cdr(assoc 0 enlist)))

;;;--- If group 66 then there are attributes nested inside this block
(setq group66(cdr(assoc 66 enlist)))

;;;--- Loop while the type is an attribute or a nested attribute exist
(while(or (= blkType "ATTRIB")(= group66 1))

;;;--- Get the block type
(setq blkType (cdr(assoc 0 enlist)))

;;;--- Get the block name
(setq entName (cdr(assoc 2 enlist)))

;;;--- Check to see if this is an attribute or a block
(if(= blkType "ATTRIB")
(progn

;;;--- Get the insertion point
(setq entPoint(cdr(assoc 10 enlist)))

;;;--- Get the X, Y, and Z coordinates of the insertion point
(setq entX (rtos (car entPoint) 2 2))
(setq entY (rtos (cadr entPoint) 2 2))
;(setq entZ (rtos (caddr entPoint) 2 2))

;;;--- Save the layer
(setq entLay(cdr(assoc 8 enlist)))

;;;--- Save the name of the attribute
(setq attTag(cdr(assoc 2 enlist)))

;;;--- Get the value of the attribute
(setq attVal(cdr(assoc 1 enlist)))

;;;--- Get the style of the attribute
(setq entSty(cdr(assoc 7 enlist)))

;;;--- Get the rotation of the attribute
(if(assoc 50 enlist)
(setq entRot(angtos(cdr(assoc 50 enlist))0 2))
(setq entRot "0.0000")
)

;;;--- Get the handle
(if(not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Get the color of the attribute
(if(cdr(assoc 62 enlist))(setq entClr(cdr(assoc 62 enlist)))(setq entClr "BYLAYER"))
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
entPoint ; arrow point
(polar entPoint (* pi 1.25) (* 4.0 (getvar "textsize"))) ; text point
)
)

;;;--- Build a data string
(setq dStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum))))))
(if(= tog1 "1")(setq dStr (append dStr (list entName))))
(if(= tog2 "1")(setq dStr (append dStr (list entLay))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr))))
(if(= tog4 "1")(setq dStr (append dStr (list entX entY))))
(if(= tog7 "1")(setq dStr (append dStr (list attTag))))
(if(= tog8 "1")(setq dStr (append dStr (list attVal))))
(if(= tog9 "1")(setq dStr (append dStr (list entSty))))
(if(= tog16 "1")(setq dStr (append dStr (list entRot))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))

;;;--- Get the next sub-entity or nested entity as you will
(setq en(entnext en))

;;;--- Get the dxf group codes of the next sub-entity
(setq enlist(entget en))

;;;--- Get the block type of the next sub-entity
(setq blkType (cdr(assoc 0 enlist)))

;;;--- See if the dxf group code 66 exist. if so, there are more nested attributes
(setq group66(cdr(assoc 66 enlist)))
)
)
)
)
)
(setq blkCntr (+ blkCntr 1))
)
)
)
dataList
)

;;;--- CIRCLE DATA

(defun getCirData(/ eset hdrStr en enlist entLyr entPt entRad entDia entLty entClr dstr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "CIRCLE"))
(setq eset(ssget "X" (list (cons 0 "CIRCLE"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog5 "1")(setq hdrStr (append hdrStr (list "Center X" "Center Y"))))
(if(= tog10 "1")(setq hdrStr (append hdrStr (list "LineType"))))
(if(= tog11 "1")(setq hdrStr (append hdrStr (list "Radius"))))
(if(= tog12 "1")(setq hdrStr (append hdrStr (list "Diameter"))))
(if(= tog17 "1")(setq hdrStr (append hdrStr (list "Area"))))
(if(= tog18 "1")(setq hdrStr (append hdrStr (list "Perimeter"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))
(setq entPt(cdr(assoc 10 enlist)))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2)))
(setq entRad(rtos(cdr(assoc 40 enlist))2 2))
(setq entDia(rtos(* 2 (cdr(assoc 40 enlist)))2 2))
(setq entLen(rtos(* pi (* 2.0 (cdr(assoc 40 enlist))))2 2))
(setq entAre(rtos(* pi (expt (cdr(assoc 40 enlist)) 2))2 2))
(if(cdr(assoc 6 enlist))
(setq entLty(cdr(assoc 6 enlist)))
(setq entLty "BYLAYER")
)
(if(cdr(assoc 62 enlist))
(setq entClr(cdr(assoc 62 enlist)))
(setq entClr "BYLAYER")
)
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
(polar entPt (* pi 0.25) (atof entRad)) ; arrow point
(polar entPt (* pi 0.25) (+ (atof entRad)(* 2.0 (getvar "textsize")))) ; text point
)
)

(setq dStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum))))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr))))
(if(= tog5 "1")(setq dStr (append dStr entPtSTr)))
(if(= tog10 "1")(setq dStr (append dStr (list entLty))))
(if(= tog11 "1")(setq dStr (append dStr (list entRad))))
(if(= tog12 "1")(setq dStr (append dStr (list entDia))))
(if(= tog17 "1")(setq dStr (append dStr (list entAre))))
(if(= tog18 "1")(setq dStr (append dStr (list entLen))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- ELLIPSE DATA

(defun getEllData(/ eset hdrStr en enlist entLyr entPt entRad entDia entLty entClr dstr
entRot maAxis miAxis)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "ELLIPSE"))
(setq eset(ssget "X" (list (cons 0 "ELLIPSE"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog5 "1")(setq hdrStr (append hdrStr (list "Center X" "Center Y"))))
(if(= tog10 "1")(setq hdrStr (append hdrStr (list "LineType"))))
(if(= tog14 "1")(setq hdrStr (append hdrStr (list "Major Axis"))))
(if(= tog15 "1")(setq hdrStr (append hdrStr (list "Minor Axis"))))
(if(= tog16 "1")(setq hdrStr (append hdrStr (list "Rotation"))))
(if(= tog17 "1")(setq hdrStr (append hdrStr (list "Area"))))
(if(= tog18 "1")(setq hdrStr (append hdrStr (list "Perimeter"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))
(setq entPt(cdr(assoc 10 enlist)))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2)))
(setq maAxis(distance (list 0 0) (cdr(assoc 11 enlist))))
(setq miAxis(rtos(* maAxis (cdr(assoc 40 enlist)))2 2))
(setq maAxis(rtos maAxis 2 2))
(command "_area" "Object" en)
(setq entAre(rtos (getvar "area") 2 2))
(setq entLen(rtos (getvar "perimeter")2 2))
(if(cdr(assoc 6 enlist))
(setq entLty(cdr(assoc 6 enlist)))
(setq entLty "BYLAYER")
)
(if(cdr(assoc 62 enlist))
(setq entClr(cdr(assoc 62 enlist)))
(setq entClr "BYLAYER")
)
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))

;;;--- Get the rotation of the ellipse
(setq entRot(angtos(angle (list 0 0)(cdr(assoc 11 enlist)))0 2))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
(polar entPt (angtof entRot) (distof maAxis)) ; arrow point
(polar ; text point
(polar entPt(angtof entRot)(distof maAxis))
(angtof entRot)
(* 4.0(getvar "textsize"))
)
)
)

(setq dStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum))))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr))))
(if(= tog5 "1")(setq dStr (append dStr entPtSTr)))
(if(= tog10 "1")(setq dStr (append dStr (list entLty))))
(if(= tog14 "1")(setq dStr (append dStr (list maAxis))))
(if(= tog15 "1")(setq dStr (append dStr (list miAxis))))
(if(= tog16 "1")(setq dStr (append dStr (list entRot))))
(if(= tog17 "1")(setq dStr (append dStr (list entAre))))
(if(= tog18 "1")(setq dStr (append dStr (list entLen))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- IMAGE DATA

(defun getImgData(/ eset hdrStr en enlist entLyr entPt entClr dstr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "IMAGE"))
(setq eset(ssget "X" (list (cons 0 "IMAGE"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog4 "1")(setq hdrStr (append hdrStr (list "Insertion X" "Insertion Y"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))
(setq entPt(cdr(assoc 10 enlist)))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2)))
(if(cdr(assoc 62 enlist))
(setq entClr(cdr(assoc 62 enlist)))
(setq entClr "BYLAYER")
)
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
entPt ; arrow point
(polar entPt (* pi 1.25) (* 2.0 (getvar "textsize"))) ; text point
)
)

(setq dStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum))))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr))))
(if(= tog4 "1")(setq dStr (append dStr entPtSTr)))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- INSERT DATA (BLOCKS)

(defun getInsData(/ eset en enlist hdrStr dataList entName entPoint entX entY entZ entLay entRot dStr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "INSERT"))
(setq eset(ssget "X" (list (cons 0 "INSERT"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog1 "1")(setq hdrStr (append hdrStr (list "Name"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog4 "1")(setq hdrStr (append hdrStr (list "Insertion X" "Insertion Y"))))
(if(= tog16 "1")(setq hdrStr (append hdrStr (list "Rotation"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up some counters
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the block name
(setq entName(cdr(assoc 2 enlist)))

;;;--- Get the insertion point
(setq entPoint(cdr(assoc 10 enlist)))

;;;--- Get the X, Y, and Z coordinates of the insertion point
(setq entX (rtos (car entPoint) 2 2))
(setq entY (rtos (cadr entPoint) 2 2))
;(setq entZ (rtos (caddr entPoint) 2 2))

;;;--- Save the layer
(setq entLay(cdr(assoc 8 enlist)))

;;;--- Get the rotation of the entity
(if(assoc 50 enlist)
(setq entRot(angtos(cdr(assoc 50 enlist))0 4))
(setq entRot "0.0000")
)

;;;--- Get the color of the entity
(if(cdr(assoc 62 enlist))(setq entClr(cdr(assoc 62 enlist)))(setq entClr "BYLAYER"))
(if(= 'INT (type entClr))(setq entClr(itoa entClr)))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
entPoint ; arrow point
(polar entPoint (* pi 1.25) (* 4.0 (getvar "textsize"))) ; text point
)
)

;;;--- Build a data string
(setq dStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum))))))
(if(= tog1 "1")(setq dStr (append dStr (list entName))))
(if(= tog2 "1")(setq dStr (append dStr (list entLay))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr))))
(if(= tog4 "1")(setq dStr (append dStr (list entX entY))))
(if(= tog16 "1")(setq dStr (append dStr (list entRot))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- LINE DATA

(defun getLinData(/ eset en enlist hdrStr entLyr entPt entPtStr entEPt entLty entClr dstr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "LINE"))
(setq eset(ssget "X" (list (cons 0 "LINE"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog5 "1")(setq hdrStr (append hdrStr (list "Start X" "Start Y"))))
(if(= tog6 "1")(setq hdrStr (append hdrStr (list "End X" "End Y"))))
(if(= tog10 "1")(setq hdrStr (append hdrStr (list "LineType"))))
(if(= tog16 "1")(setq hdrStr (append hdrStr (list "Rotation"))))
(if(= tog18 "1")(setq hdrStr (append hdrStr (list "Length"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))
(setq entPt(cdr(assoc 10 enlist)))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2)))
(setq entEPt(cdr(assoc 11 enlist)))
(setq entEPtStr(list (rtos(car entEPt)2 2) (rtos(cadr entEPt)2 2)))
(setq entRot(angtos (angle entPt entEPt)0 2))
(setq entLen(rtos (distance entPt entEPt) 2 2))
(if(cdr(assoc 6 enlist))
(setq entLty(cdr(assoc 6 enlist)))
(setq entLty "BYLAYER")
)

(if(cdr(assoc 62 enlist))
(setq entClr(cdr(assoc 62 enlist)))
(setq entClr "BYLAYER")
)

(if(= 'INT (type entClr))(setq entClr (itoa entClr)))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
(polar entPt (angle entPt entEPt) (/ (distance entPt entEPt) 2.0)) ; arrow point
(polar ; text point
(polar entPt (angle entPt entEPt) (/ (distance entPt entEPt) 2.0))
(+ (* pi 0.5)(angle entPt entEPt))
(* 4.0 (getvar "textsize"))
)
)
)

(setq dStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum))))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr))))
(if(= tog5 "1")(setq dStr (append dStr entPtSTr)))
(if(= tog6 "1")(setq dStr (append dStr entEPtSTr)))
(if(= tog10 "1")(setq dStr (append dStr (list entLty))))
(if(= tog16 "1")(setq dStr (append dStr (list entRot))))
(if(= tog18 "1")(setq dStr (append dStr (list entLen))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- LWPOLYLINE DATA

(defun getLwpData(/ eset en enlist hdrStr dstr vStr entPt entPtStr entEPt entEPtStr
entLyr ptList entLty entClr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "LWPOLYLINE"))
(setq eset(ssget "X" (list (cons 0 "LWPOLYLINE"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog5 "1")(setq hdrStr (append hdrStr (list "Start X" "Start Y"))))
(if(= tog6 "1")(setq hdrStr (append hdrStr (list "End X" "End Y"))))
(if(= tog10 "1")(setq hdrStr (append hdrStr (list "LineType"))))
(if(= tog17 "1")(setq hdrStr (append hdrStr (list "Area"))))
(if(= tog18 "1")(setq hdrStr (append hdrStr (list "Length"))))
(if(= tog13 "1")(setq hdrStr (append hdrStr (list "Vertex X" "Vertex Y"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))

;;;--- Get the points in a list
(setq ptList(list))
(foreach a enlist(if(= (car a) 10)(setq ptList(append ptList (list (cdr a))))))

(setq entPt(car ptList))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2)))
(setq entEPt(car(reverse ptList)))
(setq entEPtStr(list (rtos(car entEPt)2 2) (rtos(cadr entEPt)2 2)))
(command "_area" "Object" en)
(setq entAre(rtos (getvar "area") 2 2))
(setq entLen(rtos (getvar "perimeter") 2 2))

(if(cdr(assoc 6 enlist))
(setq entLty(cdr(assoc 6 enlist)))
(setq entLty "BYLAYER")
)

(if(cdr(assoc 62 enlist))
(setq entClr(cdr(assoc 62 enlist)))
(setq entClr "BYLAYER")
)
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(setq pt1 (car ptList) pt2 (cadr ptList))
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
(polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2.0)) ; arrow point
(polar ; text point
(polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2.0))
(+ (* pi 0.5)(angle pt1 pt2))
(* 4.0 (getvar "textsize"))
)
)
)

(setq dStr(list) vStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum)))) vStr (append vStr (list " "))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr)) vStr (append vStr (list " "))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr)) vStr (append vStr (list " "))))
(if(= tog5 "1")(setq dStr (append dStr entPtSTr) vStr (append vStr (list " " " "))))
(if(= tog6 "1")(setq dStr (append dStr entEPtSTr) vStr (append vStr (list " " " "))))
(if(= tog10 "1")(setq dStr (append dStr (list entLty)) vStr (append vStr (list " "))))
(if(= tog17 "1")(setq dStr (append dStr (list entAre)) vStr (append vStr (list " "))))
(if(= tog18 "1")(setq dStr (append dStr (list entLen)) vStr (append vStr (list " "))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan)) vStr (append vStr (list " "))))
(if(= tog13 "1")(setq dStr (append dStr (list "-" "-"))))
(setq dataList(append dataList(list dStr)))

(if(= tog13 "1")
(progn
(foreach a ptList
(progn
(setq nStr(append vStr (list (rtos(car a)2 2) (rtos(cadr a)2 2))))
(setq dataList(append dataList(list nStr)))
)
)
)
)
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- MLINE DATA

(defun getMliData(/ eset en enlist hdrStr dstr vStr entPt entPtStr entEPt entEPtStr
entLyr ptList entLty entClr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "MLINE"))
(setq eset(ssget "X" (list (cons 0 "MLINE"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog9 "1")(setq hdrStr (append hdrStr (list "Style"))))
(if(= tog5 "1")(setq hdrStr (append hdrStr (list "Start X" "Start Y"))))
(if(= tog6 "1")(setq hdrStr (append hdrStr (list "End X" "End Y"))))
(if(= tog10 "1")(setq hdrStr (append hdrStr (list "LineType"))))
(if(= tog11 "1")(setq hdrStr (append hdrStr (list "Width"))))
(if(= tog18 "1")(setq hdrStr (append hdrStr (list "Length"))))
(if(= tog13 "1")(setq hdrStr (append hdrStr (list "Vertex X" "Vertex Y"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))

;;;--- Get the data from the group codes
(setq entSty(cdr(assoc 2 enlist)))

;;;--- Get the data from the group codes
(setq entWth(rtos(cdr(assoc 40 enlist))2 2))

(setq entPt(cdr(assoc 10 enlist)))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2)))

;;;--- Get the points in a list
(setq ptList(list))
(foreach a enlist(if(= (car a) 11)(setq ptList(append ptList (list (cdr a))))))
;;;--- Get the length
(setq entLen 0)
(setq spt(car ptList))
(foreach a (cdr ptList)
(setq entLen(+ entLen (distance spt a)))
(setq spt a)
)
(setq entLen(rtos entLen 2 2))
(setq entEPt(car(reverse ptList)))
(setq entEPtStr(list (rtos(car entEPt)2 2) (rtos(cadr entEPt)2 2)))
(if(cdr(assoc 6 enlist))
(setq entLty(cdr(assoc 6 enlist)))
(setq entLty "BYLAYER")
)
(if(cdr(assoc 62 enlist))
(setq entClr(cdr(assoc 62 enlist)))
(setq entClr "BYLAYER")
)
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(setq pt1 (car ptList) pt2 (cadr ptList))
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
(polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2.0)) ; arrow point
(polar ; text point
(polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2.0))
(+ (* pi 0.5)(angle pt1 pt2))
(* 4.0 (getvar "textsize"))
)
)
)

(setq dStr(list) vStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum)))) vStr(append vStr (list " "))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr)) vStr (append vStr (list " "))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr)) vStr (append vStr (list " "))))
(if(= tog9 "1")(setq dStr (append dStr (list entSty)) vStr (append vStr (list " "))))
(if(= tog5 "1")(setq dStr (append dStr entPtSTr) vStr (append vStr (list " " " " " "))))
(if(= tog6 "1")(setq dStr (append dStr entEPtSTr) vStr (append vStr (list " " " " " "))))
(if(= tog10 "1")(setq dStr (append dStr (list entLty)) vStr (append vStr (list " "))))
(if(= tog11 "1")(setq dStr (append dStr (list entWth)) vStr (append vStr (list " "))))
(if(= tog18 "1")(setq dStr (append dStr (list entLen)) vStr (append vStr (list " "))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(if(= tog13 "1")(setq dStr (append dStr (list " " " " " "))))
(setq dataList(append dataList(list dStr)))
(if(= tog13 "1")
(progn
(foreach a ptList
(progn
(setq nStr(append vStr (list (rtos(car a)2 2) (rtos(cadr a)2 2))))
(setq dataList(append dataList(list nStr)))
)
)
)
)
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- Function to break up an mtext entity into individual strings in a list

(defun mtx(mtxtVal)
;;;--- Strip trailing spaces
(while(= (substr mtxtVal (strlen mtxtVal) 1) " ")
(setq mtxtVal(substr mtxtVal 1 (-(strlen mtxtVal)1)))
)
(if(= (substr mtxtVal 1 2) "{\\")
(progn
(setq mtxtVal(substr mtxtVal 1 (-(strlen mtxtVal)1)))
(setq mcnt 1)
(while(/= (substr mtxtVal mcnt 1) ";")
(setq mcnt(+ mcnt 1))
)
(setq mtxtVal(substr mtxtVal (+ mcnt 1)))
)
)
(setq mtxtLines(list))
(setq mstpt 1 mcnt 1)
(setq msrf "\\P")
(while (< mcnt (+(-(strlen mtxtVal) (strlen msrf))1))
(setq mtstStr(substr mtxtVal mcnt (strlen msrf)))
(if(= mtstStr msrf)
(progn
(setq mtxtLines(append mtxtLines (list (substr mtxtVal mstpt (- mcnt mstpt)))))
(setq mstpt (+ mcnt 2))
(setq mcnt(+ mcnt 1))
)
)
(setq mcnt(+ mcnt 1))
)
(if(< mstpt (strlen mtxtVal))
(setq mtxtLines(append mtxtLines (list (substr mtxtVal mstpt))))
)
mtxtLines
)

;;;--- Function to strip control characters from mtext

(defun stripIt(sTxt / stripList sa sCntr sChk)
(setq stripList (list "\\O" "\\o" "\\L" "\\l" "\\~" "\\A" "\\P"))
(foreach sa stripList
(setq sCntr 1)
(while(< sCntr (strlen sTxt))
(setq sChk(substr sTxt sCntr 2))
(if(= sChk sa)
(progn
(if(= sCntr 1)
(setq sTxt (substr sTxt 3))
(setq sTxt (strcat (substr sTxt 1 (- sCntr 1)) (substr sTxt (+ sCntr 2))))
)
)
)
(setq sCntr(+ sCntr 1))
)
)
sTxt
)

;;;--- MTEXT DATA

(defun getMtxData(/ eset en enlist hdrStr entLyr entSty bigStr bigList
entPt entPtStr entVal entHgt entWth entRot dStr vStr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "MTEXT"))
(setq eset(ssget "X" (list (cons 0 "MTEXT"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog4 "1")(setq hdrStr (append hdrStr (list "Insertion X" "Insertion Y"))))
(if(= tog8 "1")(setq hdrStr (append hdrStr (list "Text Value"))))
(if(= tog9 "1")(setq hdrStr (append hdrStr (list "Style"))))
(if(= tog11 "1")(setq hdrStr (append hdrStr (list "Height"))))
(if(= tog12 "1")(setq hdrStr (append hdrStr (list "Width"))))
(if(= tog16 "1")(setq hdrStr (append hdrStr (list "Rotation"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))
(setq entSty(cdr(assoc 7 enlist)))
(setq entPt(cdr(assoc 10 enlist)))
(if(assoc 3 enlist)
(progn
(setq bigStr "")
(foreach a enlist(if(= (car a) 3)(setq bigStr(strcat bigStr (cdr a)))))
(setq bigStr(strcat bigStr (cdr(assoc 1 enlist))))
)
(setq bigStr(cdr(assoc 1 enlist)))
)

;;;--- Get rid of the font control data inside brackets {}
(setq bigList(mtx bigStr))
(setq entVal "")
(foreach a bigList
(setq entVal(strcat entVal " " a))
)
;;;--- Get rid of the control characters
(setq entVal(stripIt entVal))
;;;--- Strip prefixed spaces
(while (= (substr entVal 1 1) " ")(setq entVal(substr entVal 2)))
;;;--- Strip suffixed spaces
(while (= (substr entVal (strlen entVal) 1) " ")(setq entVal(substr entVal 1 (-(strlen entVal)1))))

(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2)))
(if(cdr(assoc 62 enlist))(setq entClr(cdr(assoc 62 enlist)))(setq entClr "BYLAYER"))
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))
(setq entHgt(rtos(cdr(assoc 43 enlist))2 2))
(setq entWth(rtos(cdr(assoc 42 enlist))2 2))
(setq entRot(angtos (cdr(assoc 50 enlist)) 0 2))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
entPt ; arrow point
(polar entPt (* pi 1.25) (* 4.0 (getvar "textsize"))) ; text point
)
)

(setq dStr(list) vStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum)))) vStr (append vStr (list " "))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr)) vStr (append vStr (list " "))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr)) vStr (append vStr (list " "))))
(if(= tog4 "1")(setq dStr (append dStr entPtSTr) vStr (append vStr (list " " " "))))
(if(= tog8 "1")(setq dStr (append dStr (list entVal)) vStr (append vStr (list " "))))
(if(= tog9 "1")(setq dStr (append dStr (list entSty))))
(if(= tog11 "1")(setq dStr (append dStr (list entHgt))))
(if(= tog12 "1")(setq dStr (append dStr (list entWth))))
(if(= tog16 "1")(setq dStr (append dStr (list entRot))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- POINT DATA

(defun getPoiData(/ eset en enlist hdrStr entLyr entPt entPtStr entClr entRot dstr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "POINT"))
(setq eset(ssget "X" (list (cons 0 "POINT"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog4 "1")(setq hdrStr (append hdrStr (list "Insertion X" "Insertion Y"))))
(if(= tog16 "1")(setq hdrStr (append hdrStr (list "Rotation"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))
(setq entPt(cdr(assoc 10 enlist)))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2)))
(if(cdr(assoc 62 enlist))(setq entClr(cdr(assoc 62 enlist)))(setq entClr "BYLAYER"))
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))
(if(cdr(assoc 50 enlist))(setq entRot(rtos(cdr(assoc 50 enlist))2 2))(setq entRot "0.00"))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
entPt ; arrow point
(polar entPt (* pi 1.25) (* 4.0 (getvar "textsize"))) ; text point
)
)

(setq dStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum))))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr))))
(if(= tog4 "1")(setq dStr (append dStr entPtSTr)))
(if(= tog16 "1")(setq dStr (append dStr (list entRot))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- POLYLINE DATA

(defun getPolData(/ eset en enlist hdrStr dstr vStr entPt entPtStr entEPt entEPtStr cntr entLyr ptList entLty entClr en2 enlist2)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "POLYLINE"))
(setq eset(ssget "X" (list (cons 0 "POLYLINE"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog5 "1")(setq hdrStr (append hdrStr (list "Start X" "Start Y"))))
(if(= tog6 "1")(setq hdrStr (append hdrStr (list "End X" "End Y"))))
(if(= tog10 "1")(setq hdrStr (append hdrStr (list "LineType"))))
(if(= tog17 "1")(setq hdrStr (append hdrStr (list "Area"))))
(if(= tog18 "1")(setq hdrStr (append hdrStr (list "Length"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(if(= tog13 "1")(setq hdrStr (append hdrStr (list "Vertex X" "Vertex Y"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))

;;;--- Get the points in a list
(setq ptList(list))

;;;--- Get the sub entities name
(setq en2(entnext en))

;;;--- Get the dxf group codes of the subentity
(setq enlist2(entget en2))

;;;--- While the polyline has a next vertice
(while (not (equal (cdr(assoc 0 (entget(entnext en2))))"SEQEND"))

;;;--- Get the next subentity
(setq en2(entnext en2))

;;;--- Get its dxf group codes
(setq enlist2(entget en2))

;;;--- Check to make sure it is not a spline reference point
(if(/= 16 (cdr(assoc 70 enlist2)))

;;;--- It is a vertex, save the point in a list [ptlist]
(setq ptList(append ptList (list (cdr(assoc 10 enlist2)))))

)
)

(setq entPt(car ptList))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2) ))
(setq entEPt(car(reverse ptList)))
(setq entEPtStr(list (rtos(car entEPt)2 2) (rtos(cadr entEPt)2 2) ))
(command "_area" "Object" en)
(setq entAre(rtos (getvar "area") 2 2))
(setq entLen(rtos (getvar "perimeter") 2 2))
(if(cdr(assoc 6 enlist))
(setq entLty(cdr(assoc 6 enlist)))
(setq entLty "BYLAYER")
)
(if(cdr(assoc 62 enlist))
(setq entClr(cdr(assoc 62 enlist)))
(setq entClr "BYLAYER")
)
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(setq pt1 (car ptList) pt2 (cadr ptList))
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
(polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2.0)) ; arrow point
(polar ; text point
(polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2.0))
(+ (* pi 0.5)(angle pt1 pt2))
(* 4.0 (getvar "textsize"))
)
)
)

(setq dStr(list) vStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum)))) vStr (append vStr (list " "))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr)) vStr (append vStr (list " "))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr)) vStr (append vStr (list " "))))
(if(= tog5 "1")(setq dStr (append dStr entPtSTr) vStr (append vStr (list " " " " " "))))
(if(= tog6 "1")(setq dStr (append dStr entEPtSTr) vStr (append vStr (list " " " " " "))))
(if(= tog10 "1")(setq dStr (append dStr (list entLty)) vStr (append vStr (list " "))))
(if(= tog17 "1")(setq dStr (append dStr (list entAre)) vStr (append vStr (list " "))))
(if(= tog18 "1")(setq dStr (append dStr (list entLen)) vStr (append vStr (list " "))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan)) vstr (append vStr (list " "))))
(if(= tog13 "1")(setq dStr (append dStr (list " " " " " "))))

(setq dataList(append dataList(list dStr)))
(if(= tog13 "1")
(progn
(foreach a ptList
(progn
(setq nStr(append vStr (list (rtos(car a)2 2) (rtos(cadr a)2 2) )))
(setq dataList(append dataList(list nStr)))
)
)
)
)
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- SOLID DATA

(defun getSolData(/ eset en enlist hdrStr entLyr entPt entPtStr entEPt entLty entClr dstr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "SOLID"))
(setq eset(ssget "X" (list (cons 0 "SOLID"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog10 "1")(setq hdrStr (append hdrStr (list "Line Type"))))
(if(= tog5 "1")(setq hdrStr (append hdrStr (list "1st X" "1st Y"))))
(setq c(list "2nd X" "2nd Y" "3rd X" "3rd Y" "4th X" "4th Y"))
(if(= tog13 "1")(setq hdrStr (append hdrStr c)))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))
(setq entPt(cdr(assoc 10 enlist)))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2) ))
(setq entPt11(cdr(assoc 11 enlist)))
(setq entPtStr11(list (rtos(car entPt11)2 2) (rtos(cadr entPt11)2 2) ))
(setq entPt12(cdr(assoc 12 enlist)))
(setq entPtStr12(list (rtos(car entPt12)2 2) (rtos(cadr entPt12)2 2) ))
(setq entPt13(cdr(assoc 13 enlist)))
(setq entPtStr13(list (rtos(car entPt13)2 2) (rtos(cadr entPt13)2 2) ))
(if(cdr(assoc 6 enlist))
(setq entLty(cdr(assoc 6 enlist)))
(setq entLty "BYLAYER")
)
(if(cdr(assoc 62 enlist))
(setq entClr(cdr(assoc 62 enlist)))
(setq entClr "BYLAYER")
)
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
entPt ; arrow point
(polar entPt (* pi 0.75) (* 4.0 (getvar "textsize"))) ; text point
)
)

(setq dStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum))))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr))))
(if(= tog10 "1")(setq dStr (append dStr (list entLty))))
(if(= tog5 "1")(setq dStr (append dStr entPtStr)))
(if(= tog13 "1")(setq dStr (append dStr (append entPtStr11 (append entPtStr12 entPtStr13)))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- TEXT DATA

(defun getTxtData(/ eset en enlist hdrStr cntr entLyr entSty bigStr bigList
entPt entPtStr entVal entHgt entWth entRot dStr vStr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "TEXT"))
(setq eset(ssget "X" (list (cons 0 "TEXT"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog5 "1")(setq hdrStr (append hdrStr (list "Start X" "Start Y"))))
(if(= tog8 "1")(setq hdrStr (append hdrStr (list "Text Value"))))
(if(= tog9 "1")(setq hdrStr (append hdrStr (list "Style"))))
(if(= tog11 "1")(setq hdrStr (append hdrStr (list "Height"))))
(if(= tog16 "1")(setq hdrStr (append hdrStr (list "Rotation"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))
(setq entSty(cdr(assoc 7 enlist)))
(setq entPt(cdr(assoc 10 enlist)))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2) ))
(setq entVal(cdr(assoc 1 enlist)))

(if(cdr(assoc 62 enlist))(setq entClr(cdr(assoc 62 enlist)))(setq entClr "BYLAYER"))
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))
(setq entHgt(rtos(cdr(assoc 40 enlist))2 2))
(setq entRot(angtos(cdr(assoc 50 enlist))0 2))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
entPt ; arrow point
(polar entPt (* pi 1.25) (* 4.0 (getvar "textsize"))) ; text point
)
)

(setq dStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum))))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr))))
(if(= tog5 "1")(setq dStr (append dStr entPtSTr)))
(if(= tog8 "1")(setq dStr (append dStr (list entVal))))
(if(= tog9 "1")(setq dStr (append dStr (list entSty))))
(if(= tog11 "1")(setq dStr (append dStr (list entHgt))))
(if(= tog16 "1")(setq dStr (append dStr (list entRot))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- TRACE DATA

(defun getTraData(/ eset en enlist hdrStr entLyr entPt entPtStr entEPt entLty entClr dstr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "TRACE"))
(setq eset(ssget "X" (list (cons 0 "TRACE"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog10 "1")(setq hdrStr (append hdrStr (list "Line Type"))))
(if(= tog5 "1")(setq hdrStr (append hdrStr (list "1st X" "1st Y"))))
(setq c(list "2nd X" "2nd Y" "3rd X" "3rd Y" "4th X" "4th Y"))
(if(= tog13 "1")(setq hdrStr (append hdrStr c)))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while (< cntr (sslength eset))

;;;--- Get the entity's name
(setq en(ssname eset cntr))

;;;--- Get the DXF group codes of the entity
(setq enlist(entget en))

;;;--- Get the data from the group codes
(setq entLyr(cdr(assoc 8 enlist)))
(setq entPt(cdr(assoc 10 enlist)))
(setq entPtStr(list (rtos(car entPt)2 2) (rtos(cadr entPt)2 2) ))
(setq entPt11(cdr(assoc 11 enlist)))
(setq entPtStr11(list (rtos(car entPt11)2 2) (rtos(cadr entPt11)2 2) ))
(setq entPt12(cdr(assoc 12 enlist)))
(setq entPtStr12(list (rtos(car entPt12)2 2) (rtos(cadr entPt12)2 2) ))
(setq entPt13(cdr(assoc 13 enlist)))
(setq entPtStr13(list (rtos(car entPt13)2 2) (rtos(cadr entPt13)2 2) ))
(if(cdr(assoc 6 enlist))
(setq entLty(cdr(assoc 6 enlist)))
(setq entLty "BYLAYER")
)
(if(cdr(assoc 62 enlist))
(setq entClr(cdr(assoc 62 enlist)))
(setq entClr "BYLAYER")
)
(if(= 'INT (type entClr))(setq entClr (itoa entClr)))

;;;--- Get the handle
(if (not (setq entHan(cdr(assoc 5 enlist))))
(setq entHan "OFF")
)

;;;--- Send a label and two points to the writeLabel function
(if labelTog
(writeLabel
(strcat lblPrefix (itoa lblStrtNum)) ; label
entPt ; arrow point
(polar entPt (* pi 1.25) (* 4.0 (getvar "textsize"))) ; text point
)
)

(setq dStr(list))
(if labelTog (setq dStr (append dStr (list (strcat lblPrefix (itoa lblStrtNum))))))
(if(= tog2 "1")(setq dStr (append dStr (list entLyr))))
(if(= tog3 "1")(setq dStr (append dStr (list entClr))))
(if(= tog10 "1")(setq dStr (append dStr (list entLty))))
(if(= tog5 "1")(setq dStr (append dStr entPtStr)))
(if(= tog13 "1")(setq dStr (append dStr (append entPtStr11 (append entPtStr12 entPtStr13)))))
(if(= tog19 "1")(setq dStr (append dStr (list entHan))))
(setq dataList(append dataList(list dStr)))
(setq cntr (+ cntr 1))
(if labelTog(setq lblStrtNum(+ lblStrtNum 1)))
)
)
)
dataList
)

;;;--- XLINE DATA

(defun getXliData(/ eset en enlist hdrStr entLyr entPt entPtStr entEPt entLty entClr dstr)

;;;--- Set up an empty list
(setq dataList(list))

;;;--- If that type of entity exist in drawing
(if (= tog20 "1")
(setq eset(windowedSelection "XLINE"))
(setq eset(ssget "X" (list (cons 0 "XLINE"))))
)

(if eset
(progn

;;;--- Build a header
(setq hdrStr(list))
(if labelTog (setq hdrStr (append hdrStr (list "Label"))))
(if(= tog2 "1")(setq hdrStr (append hdrStr (list "Layer"))))
(if(= tog3 "1")(setq hdrStr (append hdrStr (list "Color"))))
(if(= tog4 "1")(setq hdrStr (append hdrStr (list "Insertion X" "Insertion Y"))))
(if(= tog10 "1")(setq hdrStr (append hdrStr (list "LineType"))))
(if(= tog16 "1")(setq hdrStr (append hdrStr (list "Rotation"))))
(if(= tog19 "1")(setq hdrStr (append hdrStr (list "Handle"))))
(setq dataList(append dataList (list hdrStr)))

;;;--- Set up a counter
(setq cntr 0)

;;;--- Loop through each entity
(while ( (strlen b) colWidth)(setq colWidth(strlen b)))
)
)

(setq colText "")
(repeat colWidth (setq colText (strcat colText "W")))

;;;--- Convert characters to inches to get column widths
(setq tb(textbox (list(cons 0 "TEXT")(cons 1 colText)(cons 40 (getvar "textsize")))))
(setq colWidth(- (car (cadr tb)) (car(car tb))))

;;;--- Get the header from the data list and remove it from the list
(setq header(car dList))
(setq dList(cdr dList))

;;;--- Get the model space object
(setq acadSpace(vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object))))

;;;--- Get the table insertion point
(setq insPt(getpoint "\nTable Insertion Point: "))

;;;--- Divide the tables into 50 entities max
(if(> (length dList) maximumObjects)
(setq numTables(+ 1(fix(/ (length dList) (float maximumObjects)))))
(setq numTables 1)
)

;;;--- Set a list pointer
(setq itemNo 0)

;;;--- Create tables with a set maximum objects
(repeat numTables

;;;--- Get the length of this table
(if(> (- (length dList) itemNo) (- maximumObjects 1))
(setq tableLength maximumObjects)
(setq tableLength (- (length dList) itemNo))
)

;;;--- Set the number of columns
(setq numColumns (length (car dList)))

;;;--- ReSet the start point if necessary
(if(> itemNo 0)
(setq insPt(polar insPt 0 (+ (* 1.5 (getvar "textsize"))(* colWidth numColumns))))
)

;;;--- Set the number of rows to the table length plus two for title and header
(setq numRows (+ tableLength 2))

;;;--- Draw the table
(setq myTable
(vla-AddTable
acadSpace ;model space
(vlax-3d-point insPt) ;insertion point
numRows ;number of rows
numColumns ;number of columns
(* 1.5 (getvar "textsize")) ;row height
colWidth ;column width
)
)

;;;--- Set the text height for all cells
(setq row -1)
(repeat numRows
(setq row(+ row 1) col -1)
(repeat numColumns
(setq col(+ col 1))
(vla-setcelltextheight myTable row col (getvar "textsize"))
)
)

;;;--- Place the main title vla-setText syntax -> tblName col row header
(vla-setText mytable 0 0 title)

;;;--- Place the headers
(setq col 1 row 0)
(foreach a header
(vla-setText myTable col row a)
(setq row(+ row 1))
)

;;;--- Set up variables to add the cell values from the data list
(setq row 0 col 2 cnt (length dList) cntr (* 1.0 itemNo) str nil)

;;;--- Cycle through the list
(repeat tableLength

;;;--- Get the nth item in the list
(setq a(nth itemNo dList))

;;;--- Increment to get the next item
(setq itemNo(+ itemNo 1))

;;;--- If this is not the first cycle...display a percentage complete
(if(> cntr 0.0)
(progn
(if str(repeat(strlen str)(princ (chr 8))))
(setq str(strcat (rtos(* 100(/ cntr cnt))2 0) "%"))
(princ str)
(princ)
)
)

;;;--- Increment the percentage counter
(setq cntr(+ cntr 1.0))

;;;--- Place a row of cell values in the table
(foreach b a
(vla-setText myTable col row b)
(setq row(+ row 1))
)

;;;--- Increment to the next column
(setq col(+ col 1))

;;;--- Reset the row
(setq row 0)
)

;;;--- Release the table object
(vlax-release-object myTable)
(if str(repeat(strlen str)(princ (chr 8))))
(princ "100%")
)

;;;--- Release the autocad object
(vlax-release-object acadSpace)

)

;;;--- Function to enable or disable the layer list
(defun toggleLabel()
(if(= (get_tile "labeltog") "1")
(progn
(mode_tile "layerlist" 0)
(mode_tile "lblprefix" 0)
(mode_tile "lblstrtnum" 0)
)
(progn
(mode_tile "layerlist" 1)
(mode_tile "lblprefix" 1)
(mode_tile "lblstrtnum" 1)
)
)
)

;;;--- Function save the dialog box selections

(defun saveVars()
(setq entType(atoi(get_tile "entityType")))
(setq tog1 (get_tile "tog1"))
(setq tog2 (get_tile "tog2"))
(setq tog3 (get_tile "tog3"))
(setq tog4 (get_tile "tog4"))
(setq tog5 (get_tile "tog5"))
(setq tog6 (get_tile "tog6"))
(setq tog7 (get_tile "tog7"))
(setq tog8 (get_tile "tog8"))
(setq tog9 (get_tile "tog9"))
(setq tog10(get_tile "tog10"))
(setq tog11(get_tile "tog11"))
(setq tog12(get_tile "tog12"))
(setq tog13(get_tile "tog13"))
(setq tog14(get_tile "tog14"))
(setq tog15(get_tile "tog15"))
(setq tog16(get_tile "tog16"))
(setq tog17(get_tile "tog17"))
(setq tog18(get_tile "tog18"))
(setq tog19(get_tile "tog19"))
(setq tog20(get_tile "tog20"))
(setq labelTog(get_tile "labeltog"))
(if(= labelTog "1")
(progn
(setq labelTog T)
(setq layerIndex(atoi(get_tile "layerlist")))
(setq layerChoice(nth layerIndex layerList))
)
(setq labelTog nil)
)
(setq lblPrefix(get_tile "lblprefix"))
(setq lblStrtNum(fix(atof(get_tile "lblstrtnum"))))

;;;--- Save the settings to be used as defaults next time
(setvar "useri1" entType)
(setq togVal 0)
(if(= tog1 "1")(setq togVal(+ togVal 1)))
(if(= tog2 "1")(setq togVal(+ togVal 2)))
(if(= tog3 "1")(setq togVal(+ togVal 4)))
(if(= tog4 "1")(setq togVal(+ togVal 8)))
(if(= tog5 "1")(setq togVal(+ togVal 16)))
(if(= tog6 "1")(setq togVal(+ togVal 32)))
(if(= tog7 "1")(setq togVal(+ togVal 64)))
(if(= tog8 "1")(setq togVal(+ togVal 128)))
(if(= tog9 "1")(setq togVal(+ togVal 256)))
(if(= tog10 "1")(setq togVal(+ togVal 512)))
(if(= tog11 "1")(setq togVal(+ togVal 1024)))
(if(= tog12 "1")(setq togVal(+ togVal 2048)))
(if(= tog13 "1")(setq togVal(+ togVal 4096)))
(if(= tog14 "1")(setq togVal(+ togVal 8192)))
(if(= tog15 "1")(setq togVal(+ togVal 16384)))
(if(= tog16 "1")(setq togVal(+ togVal 32768)))
(if(= tog17 "1")(setq togVal(+ togVal 65536)))
(if(= tog18 "1")(setq togVal(+ togVal 131072)))
(if(= tog19 "1")(setq togVal(+ togVal 262144)))
(if(= tog20 "1")(setq togVal(+ togVal 524288)))
(setvar "users1" (itoa togVal))
(if labelTog
(setvar "useri2" 1)
(setvar "useri2" 0)
)
(if layerIndex
(setvar "useri3" layerIndex)
)
(setvar "users2" lblPrefix)
(setvar "useri4" lblStrtNum)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; ;;;
;;; ;;;
;;; ;;;
;;; M A I N A P P L I C A T I O N ;;;
;;; ;;;
;;; ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(vl-load-com)

(defun EtableMain()

;;;--- Turn the command echo off
(setvar "cmdecho" 0)

;;;--- Save the text size for scaling purposes
(setq txtSz(getvar "textsize"))

;;;--- Build a list to make a choice in the dialog box
(setq entityType(list))
(setq entityType
(list
"ARC" "ATTRIB" "CIRCLE" "ELLIPSE" "IMAGE" "INSERT (BLOCK)" "LINE" "LWPOLYLINE"
"MLINE" "MTEXT" "POINT" "POLYLINE" "SOLID" "TEXT" "TRACE" "XLINE"
)
)

;;;--- Build a list to hold the layer names
(setq layerList(list))
(setq tbl(tblnext "LAYER" T))
(while tbl
(setq layerList(append layerList (list (cdr(assoc 2 tbl)))))
(setq tbl(tblnext "LAYER"))
)

;;;--- Load the dialog from file if found
(setq dcl_id (load_dialog "ETABLE.dcl"))

;;;--- Load the dialog definition inside the DCL file
(if (not (new_dialog "ETABLE" dcl_id))
(progn
(alert "The ETABLE.DCL file could not be found.\nPlease make sure this file is located within the autocad search path.")
(exit)
)
)

;;;--- Add the entity list to the dialog box
(start_list "entityType" 3)
(mapcar 'add_list entityType)
(end_list)

;;;--- Add the layer list to the dialog box
(start_list "layerlist" 3)
(mapcar 'add_list layerList)
(end_list)

;;;--- Set the default properties for the first run
(setAble)

;;;--- Set the default as the first item
(set_tile "entityType" "0")

;;;--- Get the entity default if it exist
(if(and (> (getvar "useri1") -1)( (atoi(getvar "users1")) 0)
(progn
(setq togVal (atoi(getvar "users1")))
(if(>= togVal 524288)(progn(setq togVal(- togVal 524288))(set_tile "tog20" "1")))
(if(>= togVal 262144)(progn(setq togVal(- togVal 262144))(set_tile "tog19" "1")))
(if(>= togVal 131072)(progn(setq togVal(- togVal 131072))(set_tile "tog18" "1")))
(if(>= togVal 65536)(progn(setq togVal(- togVal 65536))(set_tile "tog17" "1")))
(if(>= togVal 32768)(progn(setq togVal(- togVal 37768))(set_tile "tog16" "1")))
(if(>= togVal 16384)(progn(setq togVal(- togVal 16384))(set_tile "tog15" "1")))
(if(>= togVal 8192)(progn(setq togVal(- togVal 8192))(set_tile "tog14" "1")))
(if(>= togVal 4096)(progn(setq togVal(- togVal 4096))(set_tile "tog13" "1")))
(if(>= togVal 2048)(progn(setq togVal(- togVal 2048))(set_tile "tog12" "1")))
(if(>= togVal 1024)(progn(setq togVal(- togVal 1024))(set_tile "tog11" "1")))
(if(>= togVal 512)(progn(setq togVal(- togVal 512))(set_tile "tog10" "1")))
(if(>= togVal 256)(progn(setq togVal(- togVal 256))(set_tile "tog9" "1")))
(if(>= togVal 128)(progn(setq togVal(- togVal 128))(set_tile "tog8" "1")))
(if(>= togVal 64)(progn(setq togVal(- togVal 64))(set_tile "tog7" "1")))
(if(>= togVal 32)(progn(setq togVal(- togVal 32))(set_tile "tog6" "1")))
(if(>= togVal 16)(progn(setq togVal(- togVal 16))(set_tile "tog5" "1")))
(if(>= togVal 8)(progn(setq togVal(- togVal 8))(set_tile "tog4" "1")))
(if(>= togVal 4)(progn(setq togVal(- togVal 4))(set_tile "tog3" "1")))
(if(>= togVal 2)(progn(setq togVal(- togVal 2))(set_tile "tog2" "1")))
(if(>= togVal 1)(progn(setq togVal(- togVal 1))(set_tile "tog1" "1")))

)
)

;;;--- Get the label defaults if they exist
(if(or(= (getvar "useri2") 0)(= (getvar "useri2") 1))
(set_tile "labeltog" (itoa(getvar "useri2")))
)
(if(and (> (length layerList) (getvar "useri3"))(> (getvar "useri3") -1))
(set_tile "layerlist" (itoa(getvar "useri3")))
(set_tile "layerlist" "0")
)
(set_tile "lblprefix" (getvar "users2"))
(set_tile "lblstrtnum" (itoa(getvar "useri4")))

(if(= (getvar "useri2") 0)
(progn
;;;--- Disable the label tiles
(mode_tile "layerlist" 1)
(mode_tile "lblprefix" 1)
(mode_tile "lblstrtnum" 1)
)
)

;;;--- If an action event occurs, do this function
(action_tile "labeltog" "(toggleLabel)")
(action_tile "entityType" "(setAble)")
(action_tile "cancel" "(done_dialog 1)")
(action_tile "accept" "(saveVars)(done_dialog 2)")

;;;--- Display the dialog box
(setq ddiag(start_dialog))

;;;--- Unload the dialog box from memory
(unload_dialog dcl_id)

;;;--- If the cancel button was pressed - display message
(if (= ddiag 1)
(princ "\n \n ...ETABLE Cancelled. \n ")
)

;;;--- If the "Create" button was pressed
(if (= ddiag 2)
(progn

;;;--- Check to see what type of entity it is
(cond
;;;--- ARC DATA
((= idx 0)(if(setq dataList(getArcData))(buildTable "ARC DATA" dataList)(alert "No ARCs found!")))
;;;--- ATTRIBUTE DATA
((= idx 1)(if(setq dataList(getAttData))(buildTable "ATTRIBUTE DATA" dataList)(alert "No ATTRIBUTEs found!")))
;;;--- CIRCLE DATA
((= idx 2)(if(setq dataList(getCirData)) (buildTable "CIRCLE DATA" dataList)(alert "No CIRCLEs found!")))
;;;--- ELLIPSE DATA
((= idx 3)(if(setq dataList(getEllData)) (buildTable "ELLIPSE DATA" dataList)(alert "No ELLIPSEs found!")))
;;;--- IMAGE DATA
((= idx 4)(if(setq dataList(getImgData)) (buildTable "IMAGE DATA" dataList)(alert "No IMAGEs found!")))
;;;--- BLOCK DATA
((= idx 5)(if(setq dataList(getInsData)) (buildTable "BLOCK DATA" dataList)(alert "No BLOCKs found!")))
;;;--- LINE DATA
((= idx 6)(if(setq dataList(getLinData)) (buildTable "LINE DATA" dataList)(alert "No LINEs found!")))
;;;--- LWPOLYLINE DATA
((= idx 7)(if(setq dataList(getLwpData)) (buildTable "LWPOLYLINE DATA" dataList)(alert "No LWPOLYLINEs found!")))
;;;--- MLINE DATA
((= idx 8)(if(setq dataList(getMliData))(buildTable "MLINE DATA" dataList)(alert "No MLINEs found!")))
;;;--- MTEXT DATA
((= idx 9)(if(setq dataList(getMtxData))(buildTable "MTEXT DATA" dataList)(alert "No MTEXTs found!")))
;;;--- POINT DATA
((= idx 10)(if(setq dataList(getPoiData))(buildTable "POINT DATA" dataList)(alert "No POINTs found!")))
;;;--- POLYLINE DATA
((= idx 11)(if(setq dataList(getPolData))(buildTable "POLYLINE DATA" dataList)(alert "No POLYLINEs found!")))
;;;--- SOLID DATA
((= idx 12)(if(setq dataList(getSolData))(buildTable "SOLID DATA" dataList)(alert "No SOLIDs found!")))
;;;--- TEXT DATA
((= idx 13)(if(setq dataList(getTxtData))(buildTable "TEXT DATA" dataList)(alert "No TEXTs found!")))
;;;--- TRACE DATA
((= idx 14)(if(setq dataList(getTraData))(buildTable "TRACE DATA" dataList)(alert "No TRACEs found!")))
;;;--- XLINE DATA
((= idx 15)(if(setq dataList(getXliData))(buildTable "XLINE DATA" dataList)(alert "No XLINEs found!")))
)
)
)
(princ "\n...ETABLE Complete.")
(setvar "cmdecho" 1)
(princ)
)
(defun C:ET()
(etableMain)
)
(defun C:ETABLE()
(etableMain)
)
(if(not(findfile "ETABLE.DCL"))
(princ "\n The DCL file could not be found. Please make sure it is in the autocad search path.")
)
(princ "ETABLE loaded!\n\nType ET or ETABLE to start the program.")(princ)
(c:et)

*************** ETABLE.DCL ****************

ETABLE : dialog {
label = "ETable - JefferyPSanders.com - Ver 1.2";
: column {
: boxed_column {
: popup_list { key = "entityType"; label = "Entity Type:"; width = 25; value = "0"; }
}
: boxed_row {
label = "Items to Send to Table";
: column {
: toggle { key = "tog1"; label = "Name"; }
: toggle { key = "tog2"; label = "Layer Name"; }
: toggle { key = "tog3"; label = "Color"; }
: toggle { key = "tog4"; label = "Insertion Point"; }
: toggle { key = "tog5"; label = "Start/Center Point"; }
: toggle { key = "tog6"; label = "End Point"; }
: toggle { key = "tog10"; label = "Line Type"; }
: toggle { key = "tog16"; label = "Rotation/Angle"; }
: toggle { key = "tog17"; label = "Area"; }
: toggle { key = "tog19"; label = "Handle"; }
}
: column {
: toggle { key = "tog7"; label = "Tag"; }
: toggle { key = "tog8"; label = "Text Value"; }
: toggle { key = "tog9"; label = "Style"; }
: toggle { key = "tog11"; label = "Radius/Height"; }
: toggle { key = "tog12"; label = "Diameter/Width"; }
: toggle { key = "tog13"; label = "Vertex/Control Points"; }
: toggle { key = "tog14"; label = "Major Axis"; }
: toggle { key = "tog15"; label = "Minor Axis"; }
: toggle { key = "tog18"; label = "Length/Perimeter"; }
}
}
: row {
: toggle {
key = "tog20";
label = "Select objects manually.";
}
}
: boxed_column {
: row {
: toggle {
key = "labeltog";
label = "Label Entities";
}
: popup_list {
key = "layerlist";
label = "Layer:";
width = 25;
value = "0";
}
}
: row {
: edit_box {
key = "lblprefix";
label = "Label Prefix:";
edit_width = 5;
value = "";
}
: edit_box {
key = "lblstrtnum";
label = "Start Number:";
edit_width = 12;
value = "1";
}
}
}
: row {
: boxed_row {
: button {
key = "accept";
label = " Okay ";
is_default = true;
}
: button {
key = "cancel";
label = " Cancel ";
is_default = false;
is_cancel = true;
}
}
}
}
}

Export Layers Properties List to HTML file and open it

(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)