;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;;; ;;;ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,¤º°`°º¤;;; ;; ;; ;; ;; ;; --=={ 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 . "") (-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<< Error Retrieving Linetype >>") (if ltlst (if (vl-position lt ltlst) (princ (strcat "\n<< " lt " Linetype Already Listed >>")) (progn (setq ltlst (cons lt ltlst)) (princ (strcat "\n<< " lt " Linetype Added to List >>")))) (progn (setq ltlst (cons lt ltlst)) (princ (strcat "\n<< " lt " Linetype Added to List >>")))))) (t (if ltlst (if (vl-position lt ltlst) (princ (strcat "\n<< " lt " Linetype Already Listed >>")) (progn (setq ltlst (cons lt ltlst)) (princ (strcat "\n<< " lt " Linetype Added to List >>")))) (progn (setq ltlst (cons lt ltlst)) (princ (strcat "\n<< " lt " Linetype Added to List >>"))))))) 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<< No List Created >>"))) ((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<< Linetype not Found in Drawing >>"))))) |; ;; --===============================================================-- (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 ;; ;; ;; ;;;ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,¤º°`°º¤;;;