Calculate the total length of user specified objects


;;;ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,;;;
;;;°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,ñ║░`░║ñ;;;
;; ;;
;; ;;
;; --=={ Length Calculator }==-- ;;
;; ;;
;; This program will calculate the total length of user specified objects ;;
;; with an optional filter. The Filter may be used to select only those objects ;;
;; that are on a certain layer, or perhaps have a certain linetype or colour. ;;
;; ;;
;; The objects included in the calculation can be changed in the 'Options' ;;
;; dialog, along with the calculation precision and output type. ;;
;; ;;
;; The user can choose between three output options: ACAD Table, Txt file, or ;;
;; CSV file. If the output is set to ACAD Table, the user may select the ;;
;; Table-Style from the Drop-down in the main Dialog. ;;
;; ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;; ;;
;; FUNCTION SYNTAX: LenCal ;;
;; ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;; ;;
;; AUTHOR: ;;
;; ;;
;; Copyright ⌐ Lee McDonnell, June 2009. All Rights Reserved. ;;
;; ;;
;; { Contact: Lee Mac @ TheSwamp.org, CADTutor.net } ;;
;; ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;; ;;
;; VERSION: ;;
;; ;;
;; ° 1.0 ~ñ~ 22nd June 2009 ~ñ~ ║ First Release ;;
;;...............................................................................;;
;; ° 1.1 ~ñ~ 22nd June 2009 ~ñ~ ;;
;;...............................................................................;;
;; ° 1.2 ~ñ~ 23rd June 2009 ~ñ~ ;;
;;...............................................................................;;
;; ° 1.3 ~ñ~ 23rd June 2009 ~ñ~ ║ Fixed bugs. ;;
;;...............................................................................;;
;; ° 1.4 ~ñ~ 10th December 2009 ~ñ~ ║ Fixed bugs. ;;
;;...............................................................................;;
;; ° 1.5 ~ñ~ 21st December 2009 ~ñ~ ║ Updated Version Checking code. ;;
;;...............................................................................;;
;; ° 1.6 ~ñ~ 22nd December 2009 ~ñ~ ║ Added option to choose objects ;;
;;...............................................................................;;
;; ° 1.7 ~ñ~ 24th December 2009 ~ñ~ ║ Improved Options Dialog (with ;;
;; thanks to CAB for dialog bar). ;;
;; ║ Added Precision Options ;;
;; ║ Added alternative Output ;;
;; Options ;;
;;...............................................................................;;
;; ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;; ;;
;;;ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,;;;
;;;°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,ñ║░`░║ñ;;;

(defun c:LenCal (/ ;; --=={ Local Functions }==--

*error*
AcCm-Color
DCL_Write
ErrChk
Get_Tbl_Styl
GetObjString
List_Upd
Obj_Settings
Pad
StrBrk

;; --=={ Local Variables }==--

BPT
COL
DCTAG DCTITLE DOC
ELST ENT
FILE FLST FNAME
I
LAYLST LAYSTR LENLST LEN_SUB LST LT
OFILE OILST OLST OPTITLE OULST
SLST SPC SS
TBLOBJ TDEF TMP
UFLAG
WC
Z

;; --=={ Global Variables }==--

; *pop:def* ~ Popup_List Default
; *lst:def* ~ List_Box Default
; *tbl:stl* ~ Table Style Default
; *obj:set* ~ Object Settings Default [bit-coded]
; *len:pre* ~ Length Precision Setting
; *len:out* ~ Output Mode Setting
)

(vl-load-com)

(setq fname "LMAC_LenCal_V1.7.dcl"
dcTitle "Length Calculator V1.7"
opTitle "Options")

(or *pop:def* (setq *pop:def* "0"))
(or *lst:def* (setq *lst:def* "0"))
(or *tbl:stl* (setq *tbl:stl* "0"))
(or *obj:set* (setq *obj:set* 7 ))
(or *len:pre* (setq *len:pre* (getvar "LUPREC")))
(or *len:out* (setq *len:out* "0"))

; 1 = Line
; 2 = Lw Polyline
; 4 = Polyline
; 8 = Arc
; 16 = Circle
; 32 = Spline
; 64 = Ellipse

(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(and dcTag (unload_dialog dcTag))
(and ofile (close ofile))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))

(defun Pad (str chc len)
(while (< (strlen Str) len)
(setq str (strcat str (chr chc))))
str)

(defun StrBrk (str chrc / pos lst)
(while (setq pos (vl-string-position chrc str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos 2))))
(reverse (cons str lst)))

(defun Get_Tbl_Styl (/ tbl lst)
(if (not (vl-catch-all-error-p
(setq tbl
(vl-catch-all-apply 'vla-item
(list (vla-get-Dictionaries
(cond (doc) ((vla-get-ActiveDocument
(vlax-get-acad-object))))) "acad_tablestyle")))))

(vlax-for styl tbl
(setq lst (cons (vla-get-name styl) lst))))
(reverse lst))

(defun errchk (lst / olst)
(setq *pop:def* (get_tile "sel_fil") *tbl:stl* (get_tile "tbl_styl"))

(if (not (eq "" (setq *lst:def* (get_tile "sel_sel"))))
(progn
(setq olst (mapcar
(function
(lambda (x)
(nth x lst)))
(mapcar 'atoi (strbrk *lst:def* 32)))) (done_dialog))
(progn

(set_tile "error" "** Nothing Selected **")
(setq olst nil)))

olst)

(defun list_upd (code / lst wc col ss)

(setq doc (cond (doc) ((vla-get-ActiveDocument
(vlax-get-acad-object)))))

(cond ( (eq code 0)

(vlax-for l (vla-get-layers doc)
(setq lst (cons (vla-get-Name l) lst))))

( (eq code 1)

(vlax-for l (vla-get-linetypes doc)
(setq lst (cons (vla-get-Name l) lst)))

(setq lst (vl-remove-if
(function
(lambda (x)
(vl-position
(strcase x) '("BYLAYER" "BYBLOCK")))) lst)))

( (eq code 2)

(vlax-for l (vla-get-layers doc)
(if (not (vl-position (setq col (vla-get-color l)) lst))
(setq lst (cons col lst))))

(if (setq ss (ssget "_X" '((-4 . "<NOT")
(-4 . "")
(-4 . "NOT>"))))
(foreach x (mapcar
(function
(lambda (x)
(cdr (assoc 62 (entget x)))))
(mapcar 'cadr (ssnamex ss)))

(if (not (or (null x) (vl-position x lst)))
(setq lst (cons x lst)))))

(setq lst (vl-remove-if
(function
(lambda (x)
(vl-position (strcase x) '("BYLAYER" "BYBLOCK"))))
(mapcar 'itoa lst)))))

(if (not (eq "" (setq wc (get_tile "wc_str"))))
(progn
(setq lst
(vl-remove-if-not
(function
(lambda (x)
(wcmatch x wc))) lst))

(and (not lst) (setq lst '("-- No Matches --")))))

(start_list "sel_sel")
(mapcar 'add_list (setq lst (acad_strlsort lst)))
(end_list)

lst)

(defun AcCm-Color (/ acVer ac)
(setq acVer (substr (getvar "ACADVER") 1 2))

(if (not (vl-catch-all-error-p
(setq ac
(vl-catch-all-apply 'vla-GetInterfaceObject
(list *acad (strcat "AutoCAD.AcCmColor." acVer))))))
ac nil))

(defun dcl_write (fname / pat path ofile)

(if (not (findfile fname))
(if (setq pat (findfile "ACAD.PAT"))
(progn
(setq path (vl-filename-directory pat))

(or (eq "\\" (substr path (strlen path)))
(setq path (strcat path "\\")))

(setq ofile (open (strcat path fname) "w"))
(foreach str

'("//;ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,;//"
"//;°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,ñ║░`░║ñ;//"
"// //"
"// --=={ Length Calculator }==-- //"
"// //"
"// LenCal.dcl for use in conjunction with LenCal.lsp //"
"// Copyright ⌐ June 2009, by Lee McDonnell (Lee Mac) //"
"// //"
"//;ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,;//"
"//;°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,ñ║░`░║ñ;//"
""
"// Sub-Assembly Definitions"
""
"butt12 : button { width = 12; fixed_width = true; alignment = centered; }"
"pop15 : popup_list { width = 15; fixed_width = true; alignment = centered; }"
"tog : toggle { alignment = centered; fixed_width = false; }"
"bar : image { width = 33.26; height = 0.74; color = -15; alignment = centered; }"
""
"// Main Dialog"
""
"lencal : dialog { key = \"dctitle\";"
" : text { value = \"Copyright (c) 2009 Lee McDonnell\"; alignment = right; }"
" "
" : boxed_column { label = \"Filter\"; fixed_width = true; width = 45;"
" : popup_list { key = \"sel_fil\";alignment = centered; }"
" spacer_1; "
" }"
" "
" : boxed_column { label = \"Selection\";"
" : list_box { key = \"sel_sel\"; multiple_select = true; alignment = centered; }"
" : edit_box { key = \"wc_str\" ; label = \"Filter String:\"; edit_limit = 50;"
" value = \"*\"; alignment = centered; }"
" spacer_1; "
" }"
" "
" : boxed_column { label = \"Table Style\";"
" : popup_list { key = \"tbl_styl\"; alignment = centered; }"
" spacer_1; "
" }"
" "
" : errtile { width = 34; }"
" : row {"
" : butt12 { key = \"opt\"; label = \"Options\"; }"
" : butt12 { key = \"accept\"; label = \"OK\"; is_default = true; }"
" : butt12 { key = \"cancel\"; label = \"Cancel\"; is_cancel = true; }"
" }"
"}"
""
""
"lencal_opt : dialog { key = \"stitle\";"
" spacer;"
" : row { alignment = centered; "
" spacer;"
" : column { alignment = centered;"
" : tog { key = \"li\"; label = \"Line\"; }"
" : tog { key = \"pl\"; label = \"Polyline\"; }"
" }"
""
" : column { alignment = centered;"
" : tog { key = \"el\"; label = \"Ellipse\";}"
" : tog { key = \"ar\"; label = \"Arc\"; }"
" }"
""
" : column { alignment = centered;"
" : tog { key = \"lw\"; label = \"LW Polyline\"; }"
" : tog { key = \"ci\"; label = \"Circle\"; }"
" }"
""
" : column { alignment = centered;"
" : tog { key = \"sp\"; label = \"Spline\"; }"
" : tog { key = \"al\"; label = \"Select All\"; }"
" }"
" }"
" : row {"
" : spacer { width = 0.1; fixed_width = true; }"
" : bar { key = \"sep1\"; }"
" : spacer { width = 0.1; fixed_width = true; }"
" }"
""
" : row { alignment = centered; children_alignment = centered;"
""
" spacer;"
" : column { "
" : spacer { height = 0.1; fixed_height = true; }"
" : text { label = \"Precision:\"; }"
" }"
" : pop15 { key = \"prec\"; }"
""
" spacer;"
""
" : column {"
" : spacer { height = 0.1; fixed_height = true; }"
" : text { label = \"Output:\"; }"
" }"
" : pop15 { key = \"outp\"; }"
" spacer;"
""
" }"
""
" spacer;"
" : row {"
" : spacer { width = 0.1; fixed_width = true; }"
" : bar { key = \"sep2\"; }"
" : spacer { width = 0.1; fixed_width = true; }"
" }"
""
" ok_cancel;"
"}"
""
"/*"
"//;ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,;"
""
" End of Program Code"
""
"//;ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,;"
"*/")

(write-line str ofile))

(setq ofile (close ofile))

t)
nil)
t))

(defun GetObjString (code / n x str)
(setq n -1 str "")

(foreach x '("LINE" "LWPOLYLINE" "POLYLINE" "ARC" "CIRCLE" "SPLINE" "ELLIPSE")
(if (not (zerop (logand code (expt 2 (setq n (1+ n))))))
(setq str (strcat str x (chr 44)))))

(vl-string-right-trim "," str))

(defun Obj_Settings (dcTag / Set_tiles Tile_Bit tmp)

(defun Set_tiles (code / n x)
(setq n -1)

(foreach x '("li" "lw" "pl" "ar" "ci" "sp" "el")
(if (not (zerop (logand code (expt 2 (setq n (1+ n))))))
(set_tile x "1")
(set_tile x "0"))))

(defun Tile_Bit (key value)

(*

(if (eq value "0")
(progn
(set_tile "al" "0") -1) 1)

(expt 2 (vl-position key '("li" "lw" "pl" "ar" "ci" "sp" "el")))))

(cond ( (not (new_dialog "lencal_opt" dcTag))

(princ "\n** Options Dialog Could not be Loaded **"))

(t
(set_tile "stitle" opTitle)

(foreach x '("sep1" "sep2")
(start_image x)
(mapcar (function vector_image) '(0 0) '(6 5) '(300 300) '(6 5) '(8 7))
(end_image))

(Set_tiles *obj:set*)
(setq tmp *obj:set*) ;; For Cancel

(start_list "prec")
(mapcar 'add_list '("0" "0.0" "0.00" "0.000" "0.0000"
"0.00000" "0.000000" "0.0000000" "0.00000000"))
(end_list)
(set_tile "prec" (itoa *len:pre*))

(start_list "outp")
(mapcar 'add_list '("ACAD Table" "TXT File" "CSV File"))
(end_list)
(set_tile "outp" *len:out*)

(action_tile "prec" "(setq *len:pre* (atoi $value))")
(action_tile "outp" "(setq *len:out* $value)")

(action_tile "li" "(setq tmp (+ tmp (Tile_Bit \"li\" $value)))")
(action_tile "lw" "(setq tmp (+ tmp (Tile_Bit \"lw\" $value)))")
(action_tile "pl" "(setq tmp (+ tmp (Tile_Bit \"pl\" $value)))")
(action_tile "ar" "(setq tmp (+ tmp (Tile_Bit \"ar\" $value)))")
(action_tile "ci" "(setq tmp (+ tmp (Tile_Bit \"ci\" $value)))")
(action_tile "sp" "(setq tmp (+ tmp (Tile_Bit \"sp\" $value)))")
(action_tile "el" "(setq tmp (+ tmp (Tile_Bit \"el\" $value)))")

(action_tile "al" "(if (eq \"1\" $value) (progn (setq tmp 127) (Set_Tiles tmp)))")

(action_tile "accept"
(vl-prin1-to-string
(quote
(progn
(cond ( (zerop tmp)
(alert "Please Select at Least One Object"))

(t (setq *obj:set* tmp)
(done_dialog)))))))

(action_tile "cancel" "(done_dialog)")

(start_dialog))))

;; --=={ Main Function }==--

(setq laystr "")

(setq doc (vla-get-ActiveDocument
(setq *acad (vlax-get-Acad-Object)))

spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))

(cond ( (not (>= (distof (substr (getvar "ACADVER") 1 4)) 16.1)) ;; ACAD 2005

(princ "\n** Table Object Not Available in this Version **"))

( (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar "CLAYER"))))))

(princ "\n** Current Layer Locked **"))

( (not (dcl_write fname))

(princ "\n** DCL File Could not be Written **"))

( (<= (setq dcTag (load_dialog fname)) 0)

(princ "\n** Error Loading DCL **"))

( (not (new_dialog "lencal" dcTag))

(princ "** Error Loading Length Calculator Dialog **"))

( (not (setq sLst (get_tbl_styl)))

(princ "\n** Error Loading TableStyles **"))

(t

(start_list "tbl_styl")
(mapcar 'add_list (setq sLst (acad_strlsort sLst)))
(end_list)

(setq fLst '("Layer" "Linetype" "Colour"))
(start_list "sel_fil")
(mapcar 'add_list fLst)
(end_list)

(set_tile "dctitle" dcTitle)

(set_tile "sel_fil" *pop:def*)
(set_tile "sel_sel" *lst:def*)
(set_tile "tbl_styl" *tbl:stl*)
(setq lst (list_upd (atoi *pop:def*)))

(if (eq "0" *len:out*)
(mode_tile "tbl_styl" 0)
(mode_tile "tbl_styl" 1))

(action_tile "sel_fil"
(vl-prin1-to-string
(quote
(progn
(setq lst (list_upd (atoi $value))) (set_tile "error" "")
(setq *lst:def* (set_tile "sel_sel" "0"))))))

(action_tile "wc_str"
(vl-prin1-to-string
(quote
(progn
(setq lst (list_upd (atoi (get_tile "sel_fil"))))))))

(action_tile "opt"
(vl-prin1-to-string
(quote
(progn
(Obj_Settings dcTag)
(if (eq "0" *len:out*)
(mode_tile "tbl_styl" 0)
(mode_tile "tbl_styl" 1))))))

(action_tile "accept" "(setq olst (errchk lst))")
(action_tile "cancel" "(done_dialog)")

(start_dialog)
(setq dcTag (unload_dialog dcTag))

;; --=={ Alternative Pre-DCL Selection Method }==--

;|
(while
(progn
(initget 128 "Select List All Done")
(setq lt (getkword "\nSpecify Linetype to List [Select/List/All] : "))
(cond ((not lt) nil) ; Enter
((eq "Done" lt) nil)
((eq "Select" lt)
(if (setq ent (car (nentsel "\nSelect Object: ")))
(progn
(setq lt (strcase
(vla-get-linetype
(setq Obj (vlax-ename->vla-object ent)))))
(cond ((eq lt "BYLAYER")
(if (vl-catch-all-error-p
(vl-catch-all-apply
(function
(lambda ( )
(setq lt
(strcase
(vla-get-linetype
(vla-item
(vla-get-Layers doc) (vla-get-layer Obj)))))))))
(princ "\n<>")
(if ltlst
(if (vl-position lt ltlst)
(princ (strcat "\n<>"))
(progn
(setq ltlst (cons lt ltlst))
(princ (strcat "\n<>"))))
(progn
(setq ltlst (cons lt ltlst))
(princ (strcat "\n<>"))))))
(t (if ltlst
(if (vl-position lt ltlst)
(princ (strcat "\n<>"))
(progn
(setq ltlst (cons lt ltlst))
(princ (strcat "\n<>"))))
(progn
(setq ltlst (cons lt ltlst))
(princ (strcat "\n<>")))))))
t)) ; Stay in Loop
((eq "List" lt)
(if ltlst
(progn
(foreach lt ltlst
(princ (strcat "\n" (Pad lt 46 30)))) (textscr) t) ; Stay in Loop
(princ "\n<>")))
((eq "All" lt)
(setq ltlst nil)
(while (setq l (tblnext "LTYPE" (not l)))
(setq ltlst (cons (cdr (assoc 2 l)) ltlst))) nil) ; Exit Loop
((and (snvalid lt)
(tblsearch "LTYPE" lt))
(setq ltlst (cons (strcase lt) ltlst)))
(t (princ "\n<>")))))
|;

;; --===============================================================--

(if (and olst (not (vl-position "-- No Matches --" olst)))
(progn

(cond ( (eq "0" *pop:def*) ;; Layer Filtering

(foreach lay olst
(if (setq z -1 len_sub 0. ss (ssget "_X" (list (cons 0 (GetObjString *obj:set*))
(cons 8 lay))))
(progn

(while (setq ent (ssname ss (setq z (1+ z))))
(setq len_sub
(+ len_sub (vlax-curve-getDistatParam ent
(vlax-curve-getEndParam ent)))))

(setq lenlst (cons (list lay len_sub) lenlst)))

(princ (strcat "\n** No Objects Found on Layer: " lay " **")))))

( (eq "1" *pop:def*) ;; Linetype Filtering

(foreach lt (setq oulst (mapcar (function strcase) olst))

(while (setq tdef (tblnext "LAYER" (not tdef)))

(if (eq lt (strcase (cdr (assoc 6 tdef))))
(setq laystr (strcat (cdr (assoc 2 tdef)) (chr 44) laystr)
laylst (cons (cdr (assoc 2 tdef)) laylst))))

(setq laystr (vl-string-right-trim (chr 44) laystr))

(if (setq ss (ssget "_X" (list (cons 0 (GetObjString *obj:set*))
(cons -4 ""))))
(progn

(setq Elst
(vl-remove-if
(function
(lambda (x / l)
(and
(vl-position
(cdr (assoc 8 (entget x))) laylst)
(setq l (cdr (assoc 6 (entget x))))
(not (eq (strcase l) lt)))))

(mapcar 'cadr (ssnamex ss))))

(setq lenlst
(cons
(list lt
(apply (function +)
(mapcar
(function
(lambda (x)
(vlax-curve-getDistatParam x
(vlax-curve-getEndParam x)))) Elst))) lenlst)))

(princ (strcat "\n** No Objects Found With Linetype " lt " **")))

(setq tdef nil laystr "" laylst nil ss nil)))

( (eq "2" *pop:def*) ;; Colour Filtering

(foreach col (setq oilst (mapcar 'atoi olst))

(while (setq tdef (tblnext "LAYER" (not tdef)))

(if (eq col (cdr (assoc 62 tdef)))
(setq laystr (strcat (cdr (assoc 2 tdef)) (chr 44) laystr)
laylst (cons (cdr (assoc 2 tdef)) laylst))))

(setq laystr (vl-string-right-trim (chr 44) laystr))

(if (setq ss (ssget "_X" (list (cons 0 (GetObjString *obj:set*))
(cons -4 ""))))
(progn

(setq Elst
(vl-remove-if
(function
(lambda (x / c)
(and
(vl-position
(cdr (assoc 8 (entget x))) laylst)
(setq c (cdr (assoc 62 (entget x))))
(not (eq c col)))))

(mapcar 'cadr (ssnamex ss))))

(setq lenlst
(cons
(list (itoa col)
(apply (function +)
(mapcar
(function
(lambda (x)
(vlax-curve-getDistatParam x
(vlax-curve-getEndParam x)))) Elst))) lenlst)))

(princ (strcat "\n** No Objects Found With Colour " (itoa col) " **")))

(setq tdef nil laystr "" laylst nil))))

(if lenlst

(cond ( (and (eq "0" *len:out*) (setq bPt (getpoint "\nSelect Point for Table: ")))

(setq uflag (not (vla-StartUndoMark doc)) i 2)

(setq tblObj
(vla-addTable spc
(vlax-3D-point bPt)
(+ 2 (length lenlst)) 2 (* 1.5 (getvar "DIMTXT"))
(* (apply 'max
(mapcar 'strlen
(append (list (strcat (nth (atoi *pop:def*) fLst) " Name"))
(apply 'append
(mapcar
(function
(lambda (x)
(list (car x) (rtos (cadr x) 2 *len:pre*)))) lenlst))))) 1.5 (getvar "DIMTXT"))))

;;; (if (setq ac (AcCm-Color))
;;; (progn
;;; (vla-setRGB ac 76 153 76)
;;; (vla-put-TrueColor tblObj ac)))

(vla-put-StyleName tblObj (nth (atoi *tbl:stl*) sLst))
(vla-setText tblObj 0 0 "Length Calculation")
(vla-setText tblObj 1 0 (strcat (nth (atoi *pop:def*) fLst) " Name"))
(vla-setText tblObj 1 1 "Length")

(foreach x (reverse lenlst)
(vla-setText tblObj i 0 (car x))
(vla-setText tblObj i 1 (rtos (cadr x) 2 *len:pre*))

(setq i (1+ i)))

(setq uflag (vla-EndUndoMark doc)))

( (and (eq "1" *len:out*) (setq file (getfiled "Select Output File" "" "txt" 9)))

(setq ofile (open file "a"))
(write-line "\nLength Calculation" ofile)
(write-line (strcat (Pad (strcat "\n" (nth (atoi *pop:def*) fLst) " Name") 32 31) "Length\n") ofile)

(mapcar
(function
(lambda (x)
(write-line (strcat (Pad (car x) 32 30) (rtos (cadr x) 2 *len:pre*)) ofile)))
(reverse lenlst))

(setq ofile (close ofile)))

( (and (eq "2" *len:out*) (setq file (getfiled "Select Output File" "" "csv" 9)))

(setq ofile (open file "a"))
(write-line "Length Calculation" ofile)
(write-line (strcat (nth (atoi *pop:def*) fLst) " Name,Length") ofile)

(mapcar
(function
(lambda (x)
(write-line (strcat (car x) (chr 44) (rtos (cadr x) 2 *len:pre*)) ofile)))
(reverse lenlst))

(setq ofile (close ofile))))))

(princ "\n*Cancel*"))))

(princ))

(princ "\n°ñ║░`░║ñ° LenCal.lsp ~ Copyright ⌐ by Lee McDonnell °ñ║░`░║ñ°")
(princ "\n ~ñ~ ...Type \"LenCal\" to Invoke... ~ñ~ ")
(princ)

;;;ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,;;;
;; ;;
;; End of Program Code ;;
;; ;;
;;;°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,°ñ║░`░║ñ°,╕╕,ñ║░`░║ñ;;;

(c:lencal)