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

Advertisements

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)

Layer Properties List Export to TXT file and open it

(defun C:LLE (/ ent outf len lst lyr clr ltp hdr sep status)
(setq ent (tblnext "layer" T)
outf (open (strcat (getvar "dwgprefix")(vl-filename-base (getvar 'dwgname))
" - Layers Report.txt") "w")
len 0)
(write-line (strcat "Drawing Name --> " (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) ".dwg") outf)
(while ent
(setq lyr (cdr (assoc 2 ent))
len (max (strlen lyr) len)
ent (tblnext "layer")
lst (append (list lyr) lst)))
(setq hdr " Layer"
sep " -----")
(repeat (- len 6)
(setq hdr (strcat hdr " ")
sep (strcat sep " ")))
(write-line (strcat hdr "\tColor\t LineType\tStatus") outf)
(write-line (strcat sep "\t-----\t --------\t------") outf)
(foreach lyr (acad_strlsort lst)
(setq ent lyr
dif (- len (strlen lyr)))
(repeat dif
(setq lyr (strcat lyr " ")))
(setq ent (tblsearch "layer" ent)
clr (cdr (assoc 62 ent))
ltp (cdr (assoc 6 ent))
status ""
stat (cdr (assoc 70 ent)))
(if (minusp clr)
(setq status "Off"))
(if (= (logand stat 1) 1)
(setq status (strcat status (if (> status "") ", Frozen" "Frozen"))))
(if (= (logand stat 4) 4)
(setq status (strcat status (if (> status "") ", Locked" "Locked"))))
(write-line (strcat lyr "\t " (itoa clr) "\t" ltp "\t" status) outf))
(close outf)
(princ)
(startapp "notepad.exe" (strcat (getvar "dwgprefix")(vl-filename-base (getvar 'dwgname))
" - Layers Report.txt"))
)
(princ (strcat "Layer List Export"
))
(c:lle)

Etransmit with date and Detach any unloaded (unresolved) XREFs: source remain unchanged

(vl-load-com)
; Detach any unloaded (unresolved) XREFs
(defun C:dux ()
(vlax-for BIND_xrefname (vla-get-blocks (vla-get-ActiveDocument (vlax-get-Acad-object)))
(if (= (vla-get-isxref BIND_xrefname) ':vlax-true)
(progn
(setq BIND_cont (entget (vlax-vla-object->ename BIND_xrefname))
BIND_cont (tblsearch "BLOCK" (cdr (assoc 2 BIND_cont)))
)
(if (or (= (cdr (assoc 70 BIND_cont)) 4) (= (cdr (assoc 70 BIND_cont)) 12))
(vla-Detach BIND_xrefname)
)
)
)
)
)
(defun c:bet (/ a)
(command "undo" "mark")
;(command "undo" "end")
(c:dux)
(command "_.qsave")
(setq file (strcat "C:\Publish-PLT-PDF\\"
(vl-filename-base (getvar 'DWGNAME))
"-"
(menucmd "m=$(edtime,0,dd.mo.yy-H.MM)")

)
)
(command "-etransmit" "_cu" "_c" file)
(command "undo" "back" "y")
(princ)
)

Etransmit to predefuned directory to layout named zip

(vl-load-com)
(defun c:iln (/ a)
(if (/= 0 (getvar "TILEMODE"))
(progn
(setq TM (getvar "TILEMODE"))
(setvar "TILEMODE" 0)
)
)
(command "_.qsave"
"_.-etransmit"
"_c"
(strcat "C:\Publish-PLT-PDF\\"
(vl-filename-base (getvar 'dwgname))
" [" (getvar "CTAB") "].zip"
)
)
(if TM (setvar "TILEMODE" TM)))
(c:iln)

Dwg to Lisp Converter

;;;=======================[ MakeEntmake.lsp ]==================================
;;; Author: Charles Alan Butler Copyright© 2005-2012
;;; Version: 1.5 Nov. 10, 2012
;;; Purpose: To create a lisp that will recreate the objects selected
;;; Will not process xref or nested blocks, blocks are created
;;; from Inserts but no insert is created, you must insert
;;; Output; A lisp file with the name of the drawing contailing the lisp code
;;; Sub_Routines:
;;; _replace - replace in string
;;; dxfstrip - Strip dxf from list
;;; make_complex - Write additional lines needed for complex objects
;;; dxf - return value from a dotted pair
;;; ToString - convert item to a string by MP
;;; Requirements: -None
;;; Returns: -None
;;; Original Thread: http://www.theswamp.org/index.php?topic=4814.0
;;; Latest Version: http://www.theswamp.org/index.php?topic=31145
;;;===========================================================================
;;; Note: No error checking at this time
;;; This routine is a major rewrite of a routine found on the internet
;;; and the author of the original code is unkown
;;; Objects supported
;;; "3DFACE" "3DSOLID" "ARC" "ATTDEF" "CIRCLE" "DIMENSION"
;;; "ELLIPSE" "HATCH" "LEADER" "LWPOLYLINE" "LINE" "MTEXT"
;;; "POINT" "RAY" "REGION" "SHAPE" "SOLID" "SPLINE" "TEXT"
;;; "TRACE" "XLINE" "WIPEOUT"
;;; "TABLE" ; untested
;;; Objects not supported at this time
;;; MLine Raster Tolerance XRecord
;;;===========================================================================
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;; ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice below appear in all supporting documentation. ;
;;;
(defun C:MakeEntMake (/ idx dwg path ent entl fn sset dxfstrip
rvflag tmp
)

;;; -==- -==- -==- -==- -==- -==- -==- -==-
;;; Local Functions
;;; -==- -==- -==- -==- -==- -==- -==- -==-

;; Strip these dxf code pairs from original list
(defun dxfstrip (ent / entl dxfx)
(setq entl (entget ent)
dxfx '(-2 -1 5 102 300 330 331 340 350 360 410)
;; additional codes to strip
dxfx (cond ((= (cdr (assoc 0 entl)) "DIMENSION")
(append dxfx '(2 210))
)
((= (cdr (assoc 0 entl)) "HATCH")
(append dxfx '(67))
)
((= (cdr (assoc 0 entl)) "INSERT")
(append dxfx '(40 41 42 43 44 45 50 71 210))
)
(t (append dxfx '(210)))
)
entl (vl-remove-if '(lambda (pair) (member (car pair) dxfx)) entL)
)
;; Added additional items to be removed in simple objects
(if (vl-position (cdr(assoc 0 entl)) '("LINE""CIRCLE""ARC"))
(SETQ entl (vl-remove-if '(lambda (pair) (= (car pair) 67)) entL)
entl (vl-remove-if '(lambda (pair)
(vl-position pair '((100 . "AcDbEntity")
(100 . "AcDbLine")
(100 . "AcDbCircle")
(100 . "AcDbArc")
))) entL))
)

;; CORRECTIONS FOR SPECIAL OBJECTS
(cond
;; Make Hatch Non-associative
((= (cdr (assoc 0 entl)) "HATCH")
(setq entl (subst '(71 . 0) '(71 . 1) entl))
(setq entl (subst '(97 . 0) (assoc 97 entl) entl))
(prompt "\n*** Warning Hatch created is Non-associative ***")
)
((= (cdr (assoc 0 entl)) "LEADER")
(prompt "\n*** Warning Leader created is Non-associative ***")
)
)
;; filter out objects that can not be created at this time
entl
) ; defun

;; Write additional lines needed for complex objects
(defun make_complex (ent fn / entl)
(while (and (setq ent (entnext ent))
(setq vlst (entget ent))
(member (cdr (assoc 0 vlst)) '("VERTEX" "SEQEND"))
)
(setq entl (dxfstrip ent))
(write-line (strcat " (entmake '" (ToString entl) ")") fn)
)

) ; defun

(defun xrefp (elist / blist)
(and
(setq blist (entget (tblobjname "BLOCK" (cdr (assoc 2 elist)))))
(= 4 (logand (cdr (assoc 70 blist)) 4))
) ; and
) ; end defun

;; return value from a dotted pair
(defun dxf (x data) (cdr (assoc x data)))

;; CAB 11.04.07, updated 01.11.08
;; This one is fool proof
(defun _replace (oldtext newtext textstring / i n)
(setq n (strlen newtext))
(while (setq i (vl-string-search oldtext textstring i))
(setq textstring (vl-string-subst newtext oldtext textstring i)
i (+ i n))
)
textstring
)

;;;================================================================
;;; S t a r t o f R o u t i n e
;;;================================================================

;; Create the LISP file with the same name as the Drawing
(setq path (getvar "DWGPREFIX")
dwg (strcat path (vl-filename-base (getvar "DWGNAME")) ".lsp")
idx 0
)
;; Create a Revision Flag Using current Date & Time
(setq tmp (rtos (getvar 'cdate) 2 4))
(setq rvflag (strcat (substr tmp 5 2) "/" (substr tmp 7 2) "/"
(substr tmp 1 4) " @" (substr tmp 10 2) ":" (substr tmp 12 2)))

;; Objects supported
(setq include '("3DFACE" "3DSOLID" "ARC" "ATTDEF" "CIRCLE" "DIMENSION"
"ELLIPSE" "HATCH" "LEADER" "LWPOLYLINE" "LINE" "MTEXT"
"POINT" "RAY" "REGION" "SHAPE" "SOLID" "SPLINE" "TEXT"
"TRACE" "XLINE" "WIPEOUT"
"TABLE" ; untested
)
)
;; Objects not supported at this time
;; MLine Raster Tolerance XRecord

(cond
((setq sset (ssget)) ; get objects in selection set
(prompt (strcat "\n" (itoa (sslength sset)) " primary objects selected."))
(setq fn (open dwg "w"))
(write-line (strcat ";; Revision :" rvFlag) fn)
(write-line (strcat "(defun c:eMake ()") fn)
(repeat (sslength sset) ; Loop --------------
(setq ent (ssname sset idx))
(setq entl (dxfstrip ent))

(cond
;;=========================================================
;; Process Complex Objects
;;=========================================================
((member (cdr (assoc 0 entl)) '("POLYLINE")) ; and 3DPOLY
(write-line (strcat "(entmake '" (ToString entl) ")") fn)
(make_complex ent fn)
)
;; Process Blocks
((and (member (cdr (assoc 0 entl)) '("INSERT"))
(not (xrefp entl))
) ; exclude x-ref
;; fix layer to 0 in header
(setq entl (subst '(8 . "0") (assoc 8 entl) entl))
(setq entl (subst '(0 . "BLOCK") '(0 . "INSERT") entl))
(setq entl (subst '(100 . "AcDbBlockReference")
'(100 . "AcDbBlockBegin") entl ))
(setq entl (subst '(10 0.0 0.0 0.0) (assoc 10 entl) entl))

;; -------------------- CAB Nov. 10, 2010 -----------------------
;; Problem with (entget (tblobjname not returning a valid -2 entity
;; where the entity name is invalid
;; (setq data (entget (tblobjname "block" (dxf 2 entl))))
(setq data (tblsearch "block" (dxf 2 entl)))
;; -------------------- CAB Nov. 10, 2010 -----------------------

(setq entl (subst (assoc 70 data) '(70 . 0) entl)) ; get flag

(write-line (strcat " (entmake '" (ToString entl) ")") fn)

(setq data (dxf -2 data)) ; get first entity
(setq data (entget data '("*"))) ; get assoc list
(while data
(cond
((= (dxf 0 data) "INSERT")
(alert "Nested Blocks Not Supported")
(close fn)
(exit)
)
(t
;; process the object
(setq entl (dxfstrip (DXF -1 data)))
(write-line (strcat " (entmake '" (ToString entl) ")") fn)
(if (> (cdr (assoc 66 entl)) 0) ; if complex entity
(make_complex ent fn)
) ; endif
;; get next object
(and (setq data (entnext (dxf -1 data)))
(setq data (entget data '("*"))) ; get assoc list
)
)
) ; end cond stmt
) ;while

;; This is the end of block marker
(write-line
" (entmake '((0 . \"ENDBLK\") (100 . \"AcDbBlockEnd\") (8 . \"0\")))"
fn
)
)

;;=========================================================
;; Process all other Objects
;;=========================================================
((member (cdr (assoc 0 entl)) include)
(write-line (strcat " (entmake '" (ToString entl) ")") fn)
)

;;=========================================================
;; Rejected Objects
;;=========================================================
(t
(prompt
(strcat "\n*** Object not supported. [ " (cdr (assoc 0 entl)) " ] ***") )
)
;;=========================================================
) ; end cond stmt

(setq idx (1+ idx))
) ; repeat End Loop ---------------------
(write-line (strcat " (princ)") fn)
(write-line (strcat ") ; end eMaker") fn)
(close fn)
(prompt (strcat "\nFile Created: " dwg))
)
) ; end cond stmt
(princ)
)

;; Subroutine by Michael Pucket 04/15/2005
;; Returns a string
(defun ToString (x / typex)
;; convert item to a string, if x is a real use
;; the highest possible precision, if x is a
;; string double quote it, if x is a list process
;; each item in the list appropriatel, otherwise
;; just hammer item with vl-princ-to-string

;; add a leading zero if needed
;; this is caused by DIMZIN supressing leading zeros
(defun addzero(st)
(if (= (substr st 1 1) ".")
(strcat "0" st)
st
)
)

(cond
;; it's a string, return it double quoted
;; CAB added _replace to catch imbeded \\ & quotes within the string
((eq 'str (setq typex (type x)))
(setq x (_replace "\\" "\\\\" x))
(strcat "\"" (_replace "\"" "\\\"" x) "\"")
)
;; if n.0 do not add extra 0's
((and (eq 'real typex) (= (- x (fix x)) 0.0))
(addzero (rtos x 2 1))
)
;; it's a real, covert to the highest possible
;; resolution string equivalent
((eq 'real typex)
(vl-string-right-trim "0" ; by CAB
(addzero (rtos x 2 (if (zerop (- x (fix x))) 1 15))))
)

;; it's a list
((eq 'list typex)
(if (vl-list-length x)
;; it's a normal list
(strcat
(chr 40)
(ToString (car x))
(apply 'strcat
(mapcar '(lambda (x) (strcat " " (ToString x))) (cdr x))
)
(chr 41)
)

;; it's a dotted pair
(strcat (chr 40) (ToString (car x)) " . " (ToString (cdr x)) (chr 41))
)
)

;; hammer down on everything else
((vl-princ-to-string x))
)
)

(princ "\nEntity to lisp file loaded, Enter MakeEntMake to run.")
(princ)

Export table to Excel

(defun c:tbltoex ()
(pl:export-to-excel)
) ;_ end of defun

(defun pl:export-to-excel (/ ccells csheet dat excel i k newbook torel wbooks wsheets next cols)
(if (setq excel (vlax-get-or-create-object "Excel.Application"))
(progn
(setq wbooks (vlax-get-property excel 'workbooks)
newbook (vlax-invoke-method wbooks 'add 1)
wsheets (vlax-get-property newbook 'worksheets)
csheet (vlax-get-property newbook 'activesheet)
) ;_ end of setq
(while (setq dat (pl:get-tbl-data))
(if next
(setq torel (cons csheet torel)
;;; csheet (vlax-invoke-method wsheets 'add nil csheet) ;_ при использовании этой строки, при закрытии Экселя - ошибка
csheet (vlax-invoke-method wsheets 'add)
) ;_ end of setq
) ;_ end of if
(setq ccells (vlax-get-property csheet 'cells)
cols (vlax-get-property csheet 'columns)
i 0
) ;_ end of setq
(foreach y dat
(setq i (1+ i)
k 0
) ;_ end of setq
(foreach x y
(setq k (1+ k))
(pl:put-val-to-cell ccells i k x)
) ;_ end of foreach
) ;_ end of foreach
(vlax-invoke-method cols 'autofit)
(vlax-release-object cols)
(vlax-release-object ccells)
(setq next t)
) ;_ end of while
(if torel
(vlax-invoke-method (last torel) 'activate)
) ;_ end of if
(if (= (vlax-get-property excel 'visible) :vlax-false)
(vlax-put-property excel 'visible :vlax-true)
) ;_ end of if
(foreach x (cons csheet
(if torel
(append torel (list wsheets newbook wbooks excel))
(list wsheets newbook wbooks excel)
) ;_ end of if
) ;_ end of cons
(vlax-release-object x)
) ;_ end of foreach
) ;_ end of progn
(alert "Can not launch Excel!!")
) ;_ end of if
(princ)
) ;_ end of defun

(defun pl:put-val-to-cell (ccells x y val / tmp brd form)
(setq val (vl-string-trim " " val))
(vlax-put-property
(setq tmp (vlax-variant-value
(vlax-get-property
ccells
'item
(vlax-make-variant x vlax-vbinteger)
(vlax-make-variant y vlax-vbinteger)
) ;_ end of vlax-get-property
) ;_ end of vlax-variant-value
) ;_ end of setq
"Value2"
(vlax-make-variant val vlax-vbvariant)
) ;_ end of vlax-put-property
(setq brd (vlax-get-property tmp 'borders))
(vlax-put-property brd 'colorindex (vlax-make-variant -4105 3))
(if (= (type (setq form (pl:is-real-form val))) 'str)
(vlax-put-property
tmp
'numberformat
(vlax-make-variant (strcat "# ##0" form) 8)
) ;_ распознавание форматов
) ;_ end of if
(vlax-release-object brd)
(vlax-release-object tmp)
) ;_ end of defun

(defun pl:is-real-form (val)
(cond ((not (= (vl-string-trim "0123456789.," val) "")) nil)
((= (vl-string-trim "0123456789" val) "") "")
((list val)
) ;_ end of vl-remove-if-not
) ;_ end of length
) ;_ end of string
(mapcar (function
(lambda (b)
(if (or (= b 44) (= b 46))
46
48
) ;_ end of if
) ;_ end of lambda
) ;_ end of function
(vl-string->list (vl-string-left-trim "0123456789" val))
) ;_ end of mapcar
) ;_ end of vl-list->string
)
) ;_ end of cond
) ;_ end of defun

(defun pl:get-tbl-ents (/ _box)
(setq
_box
(vl-catch-all-apply
(function
(lambda (/ corn1 corn2)
(if
(and (setq corn1
(getpoint
"\nSelect LL Corner of Table : "
) ;_ end of getpoint
) ;_ end of setq
(setq corn2
(getcorner
corn1
"\nSelect UR Corner of Table : "
) ;_ end of getcorner
) ;_ end of setq
) ;_ end of and
(list corn1 corn2)
) ;_ end of if
) ;_ end of lambda
) ;_ end of function
nil
) ;_ end of vl-catch-all-apply
) ;_ end of setq
(if (cond ((not _box) (princ "\nNo selection") nil)
((vl-catch-all-error-p _box)
(princ (strcat "\n" (vl-catch-all-error-message _box)))
nil
)
(t
(setq _box (list (list (min (caar _box) (caadr _box))
(max (cadar _box) (cadadr _box))
) ;_ end of list
(list (max (caar _box) (caadr _box))
(min (cadar _box) (cadadr _box))
) ;_ end of list
) ;_ end of list
) ;_ end of setq
)
) ;_ end of cond
(list _box
(ssget "_C" (car _box) (cadr _box) '((0 . "LINE")))
(ssget "_C" (car _box) (cadr _box) '((0 . "LWPOLYLINE")))
(ssget "_C" (car _box) (cadr _box) '((0 . "TEXT")))
) ;_ end of list
) ;_ end of if
) ;_ end of defun

(defun pl:get-tbl-data (/ _sel _texts _lhrzn _lines _lvert _lwpl _modcol _modrow _mtx)
(if (setq _texts (last (setq _sel (pl:get-tbl-ents))))
(progn
(setq _lines (cadr _sel)
_lwpl (caddr _sel)
_sel (car _sel)
) ;_ end of setq
(if _lines
(setq _lines (mapcar 'pl:extr-pnt-from-line (pl:entlst-from-ss _lines)))
) ;_ end of if
(if _lwpl
(setq _lwpl (apply 'append
(mapcar 'pl:lwpl-to-segments (pl:entlst-from-ss _lwpl))
) ;_ end of apply
) ;_ end of setq
) ;_ end of if
(if
(and (setq _lines (append _lines _lwpl))
(setq _lines (vl-remove-if-not
(function
(lambda (x)
(pl:is-point-in-bbox (pl:get-cen-pnts-2d x) _sel)
) ;_ end of lambda
) ;_ end of function
_lines
) ;_ end of vl-remove-if-not
) ;_ end of setq
(setq _lines (mapcar (function
(lambda (x)
(pl:near-orto x 3)
) ;_ end of lambda
) ;_ end of function
_lines
) ;_ end of mapcar
) ;_ end of setq
(> (length
(setq _lvert (mapcar 'cdr
(vl-remove-if
(function
(lambda (x)
(or (not x)
(= (car x) 0)
) ;_ end of or
) ;_ end of lambda
) ;_ end of function
_lines
) ;_ end of vl-remove-if
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of length
1
) ;_ end of >
(> (length
(setq _lhrzn (mapcar 'cdr
(vl-remove-if
(function
(lambda (x)
(or (not x)
(= (car x) 1)
) ;_ end of or
) ;_ end of lambda
) ;_ end of function
_lines
) ;_ end of vl-remove-if
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of length
1
) ;_ end of >
) ;_ end of and
(progn
(setq _modcol (pl:get-len-perc _lvert 1.0)
_modrow (* 0.5
(apply 'min
(mapcar 'vla-get-height
(setq _texts (mapcar 'vlax-ename->vla-object
(pl:entlst-from-ss _texts)
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of mapcar
) ;_ end of apply
) ;_ end of *
_lvert (pl:clr-near-doub (pl:sort ' (pl:clr-near-doub (pl:sort 'list tmp)) 45)
(vl-string-right-trim "-" tmp)
(strcat tmp " ")
) ;_ end of if
) ;_ end of lambda
) ;_ end of function
(pl:sort (function
(lambda (a b / tmp)
(setq tmp (angle (car a) (car b)))
(or (< 0 tmp 0.52359878)
( el (- (car tmp) mod)))
tmp
(cons el tmp)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of defun

(defun pl:get-len-perc (lst perc)
(* (abs (- (apply 'max lst) (apply 'min lst))) 0.01 perc)
) ;_ end of defun

(defun pl:extr-pnt-from-line (_line / _p1 _p2)
(setq _line (entget _line)
_p1 (cdr (assoc 10 _line))
_p2 (cdr (assoc 11 _line))
) ;_ end of setq
(list (list (car _p1) (cadr _p1))
(list (car _p2) (cadr _p2))
) ;_ end of list
) ;_ end of defun

(defun pl:extr-pnt-from-lwline (_dxf)
(mapcar 'cdr
(vl-remove-if-not
(function
(lambda (x)
(= 10 (car x))
) ;_ end of lambda
) ;_ end of function
_dxf
) ;_ end of vl-remove-if-not
) ;_ end of mapcar
) ;_ end of defun

(defun pl:lwpl-to-segments (_lwline / _vert)
(setq _lwline (entget _lwline)
_vert (pl:extr-pnt-from-lwline _lwline)
) ;_ end of setq
(mapcar 'list
(if (zerop (logand 1 (cdr (assoc 70 _lwline))))
(cdr _vert)
(cons (last _vert) _vert)
) ;_ end of if
_vert
) ;_ end of mapcar
) ;_ end of defun

(defun pl:near-orto (_lstpnt _delta / _ang _dir)
(setq _ang (rem (apply 'angle _lstpnt) pi)
_delta (rem (/ (* pi _delta) 180) (* pi 2))
_dir (cond ((>= (+ (/ pi 2) _delta) _ang (- (/ pi 2) _delta)) 1)
((or (>= _delta _ang 0) (>= pi _ang (- pi _delta))) 0)
(t nil)
) ;_ end of cond
) ;_ end of setq
(if _dir
(cons _dir
(/ (apply '+
(mapcar (if (= _dir 0)
'cadr
'car
) ;_ end of if
_lstpnt
) ;_ end of mapcar
) ;_ end of apply
2
) ;_ end of /
) ;_ end of cons
) ;_ end of if
) ;_ end of defun

(defun pl:sort (func lst)
(mapcar (function
(lambda (x)
(nth x lst)
) ;_ end of lambda
) ;_ end of function
(vl-sort-i lst func)
) ;_ end of mapcar
) ;_ end of defun

(defun pl:entlst-from-ss (ss)
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
) ;_ end of defun

(defun pl:get-bbox (obj / minpoint maxpoint)
(vla-getboundingbox obj 'minpoint 'maxpoint)
(mapcar 'vlax-safearray->list (list minpoint maxpoint))
) ;_ end of defun

(defun pl:is-point-in-bbox (point bbox)
(apply 'and
(mapcar (function
(lambda (x y)
(<= (apply 'min x) y (apply 'max x))
) ;_ end of lambda
) ;_ end of function
(apply 'mapcar (cons 'list bbox))
point
) ;_ end of mapcar
) ;_ end of apply
) ;_ end of defun

(defun pl:get-cen-pnts (pntlst / len)
(setq len (length pntlst))
(list (/ (apply '+ (mapcar 'car pntlst)) len)
(/ (apply '+ (mapcar 'cadr pntlst)) len)
(/ (apply '+ (mapcar 'caddr pntlst)) len)
) ;_ end of list
) ;_ end of defun

(defun pl:get-cen-pnts-2d (pntlst / len)
(setq len (length pntlst))
(list (/ (apply '+ (mapcar 'car pntlst)) len)
(/ (apply '+ (mapcar 'cadr pntlst)) len)
) ;_ end of list
) ;_ end of defun

(apply
(function
(lambda ()
(vl-load-com)
(princ
(strcat
"\nExport Autocad Drawn Table to Excel"
"\n©2014 "
"\n\"
"\ntype 'tbltoex' to execute."
) ;_ end of strcat
) ;_ end of princ
(princ)
) ;_ end of lambda
) ;_ end of function
nil
) ;_ end of apply
(c:tbltoex)

This program was created to extract data from entities and send them to an autocad table entity.

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

;;;--- 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" "Center Z"))))
(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 4) (rtos(cadr entPt)2 4) (rtos(caddr entPt)2 4)))
(setq entRad(rtos(cdr(assoc 40 enlist))2 4))
(setq entDia(rtos(* 2 (cdr(assoc 40 enlist)))2 4))
(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" "Insertion Z"))))
(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 4))
(setq entY (rtos (cadr entPoint) 2 4))
(setq entZ (rtos (caddr entPoint) 2 4))

;;;--- 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 4))
(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 entZ))))
(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" "Center Z"))))
(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 4) (rtos(cadr entPt)2 4) (rtos(caddr entPt)2 4)))
(setq entRad(rtos(cdr(assoc 40 enlist))2 4))
(setq entDia(rtos(* 2 (cdr(assoc 40 enlist)))2 4))
(setq entLen(rtos(* pi (* 2.0 (cdr(assoc 40 enlist))))2 4))
(setq entAre(rtos(* pi (expt (cdr(assoc 40 enlist)) 2))2 4))
(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" "Center Z"))))
(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 4) (rtos(cadr entPt)2 4) (rtos(caddr entPt)2 4)))
(setq maAxis(distance (list 0 0) (cdr(assoc 11 enlist))))
(setq miAxis(rtos(* maAxis (cdr(assoc 40 enlist)))2 4))
(setq maAxis(rtos maAxis 2 4))
(command "_area" "Object" en)
(setq entAre(rtos (getvar "area") 2 4))
(setq entLen(rtos (getvar "perimeter")2 4))
(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 4))

;;;--- 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" "Insertion Z"))))
(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 4) (rtos(cadr entPt)2 4) (rtos(caddr entPt)2 4)))
(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" "Insertion Z"))))
(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 4))
(setq entY (rtos (cadr entPoint) 2 4))
(setq entZ (rtos (caddr entPoint) 2 4))

;;;--- 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 entZ))))
(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" "Start Z"))))
(if(= tog6 "1")(setq hdrStr (append hdrStr (list "End X" "End Y" "End Z"))))
(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 4) (rtos(cadr entPt)2 4) (rtos(caddr entPt)2 4)))
(setq entEPt(cdr(assoc 11 enlist)))
(setq entEPtStr(list (rtos(car entEPt)2 4) (rtos(cadr entEPt)2 4) (rtos(caddr entEPt)2 4)))
(setq entRot(angtos (angle entPt entEPt)0 4))
(setq entLen(rtos (distance entPt entEPt) 2 4))
(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 4) (rtos(cadr entPt)2 4)))
(setq entEPt(car(reverse ptList)))
(setq entEPtStr(list (rtos(car entEPt)2 4) (rtos(cadr entEPt)2 4)))
(command "_area" "Object" en)
(setq entAre(rtos (getvar "area") 2 4))
(setq entLen(rtos (getvar "perimeter") 2 4))

(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 4) (rtos(cadr a)2 4))))
(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" "Start Z"))))
(if(= tog6 "1")(setq hdrStr (append hdrStr (list "End X" "End Y" "Start Z"))))
(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" "Vertex Z"))))
(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 4))

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

;;;--- 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 4))
(setq entEPt(car(reverse ptList)))
(setq entEPtStr(list (rtos(car entEPt)2 4) (rtos(cadr entEPt)2 4) (rtos(caddr entEPt)2 4)))
(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 4) (rtos(cadr a)2 4) (rtos(caddr a)2 4))))
(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" "Insertion Z"))))
(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 4) (rtos(cadr entPt)2 4) (rtos(caddr entPt)2 4)))
(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 4))
(setq entWth(rtos(cdr(assoc 42 enlist))2 4))
(setq entRot(angtos (cdr(assoc 50 enlist)) 0 4))

;;;--- 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" "Insertion Z"))))
(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 4) (rtos(cadr entPt)2 4) (rtos(caddr entPt)2 4)))
(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 4))(setq entRot "0.0000"))

;;;--- 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" "Start Z"))))
(if(= tog6 "1")(setq hdrStr (append hdrStr (list "End X" "End Y" "End Z"))))
(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" "Vertex Z"))))
(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 4) (rtos(cadr entPt)2 4) (rtos(caddr entPt)2 4)))
(setq entEPt(car(reverse ptList)))
(setq entEPtStr(list (rtos(car entEPt)2 4) (rtos(cadr entEPt)2 4) (rtos(caddr entEPt)2 4)))
(command "_area" "Object" en)
(setq entAre(rtos (getvar "area") 2 4))
(setq entLen(rtos (getvar "perimeter") 2 4))
(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 4) (rtos(cadr a)2 4) (rtos(caddr a)2 4))))
(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" "1st Z"))))
(setq c(list "2nd X" "2nd Y" "2nd Z" "3rd X" "3rd Y" "3rd Z" "4th X" "4th Y" "4th Z"))
(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 4) (rtos(cadr entPt)2 4) (rtos(caddr entPt)2 4)))
(setq entPt11(cdr(assoc 11 enlist)))
(setq entPtStr11(list (rtos(car entPt11)2 4) (rtos(cadr entPt11)2 4) (rtos(caddr entPt11)2 4)))
(setq entPt12(cdr(assoc 12 enlist)))
(setq entPtStr12(list (rtos(car entPt12)2 4) (rtos(cadr entPt12)2 4) (rtos(caddr entPt12)2 4)))
(setq entPt13(cdr(assoc 13 enlist)))
(setq entPtStr13(list (rtos(car entPt13)2 4) (rtos(cadr entPt13)2 4) (rtos(caddr entPt13)2 4)))
(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" "Start Z"))))
(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 4) (rtos(cadr entPt)2 4) (rtos(caddr entPt)2 4)))
(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 4))
(setq entRot(angtos(cdr(assoc 50 enlist))0 4))

;;;--- 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" "1st Z"))))
(setq c(list "2nd X" "2nd Y" "2nd Z" "3rd X" "3rd Y" "3rd Z" "4th X" "4th Y" "4th Z"))
(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 4) (rtos(cadr entPt)2 4) (rtos(caddr entPt)2 4)))
(setq entPt11(cdr(assoc 11 enlist)))
(setq entPtStr11(list (rtos(car entPt11)2 4) (rtos(cadr entPt11)2 4) (rtos(caddr entPt11)2 4)))
(setq entPt12(cdr(assoc 12 enlist)))
(setq entPtStr12(list (rtos(car entPt12)2 4) (rtos(cadr entPt12)2 4) (rtos(caddr entPt12)2 4)))
(setq entPt13(cdr(assoc 13 enlist)))
(setq entPtStr13(list (rtos(car entPt13)2 4) (rtos(cadr entPt13)2 4) (rtos(caddr entPt13)2 4)))
(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" "Insertion Z"))))
(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:etable)