;;; --------------------------------------------------------------------- ;;; PLLENTAB-bgol.lsp ;;; Command: PLEN ;;; ;;; PURPOSE ;;; Computes the total length of all selected lines/polylines, grouped ;;; and summed by layer, and writes a simple tabulated summary of ;;; per-layer totals directly into the drawing at a user-picked point. ;;; Useful for quantity takeoffs (e.g. total road length, total pipe ;;; length by diameter/layer). ;;; ;;; USAGE ;;; 1. Load this file (APPLOAD or drag-drop onto the drawing window). ;;; 2. Type PLEN at the command line and press Enter. ;;; 3. Select the LINE / LWPOLYLINE entities to total. ;;; 4. Pick a point in the drawing for the results table. ;;; 5. A table of layer name vs. total length is drawn as TEXT rows ;;; on layer "BGOL-PLEN". ;;; ;;; NOTES ;;; - This is an original, independently written implementation. ;;; It is INSPIRED by the general idea of per-layer length ;;; summary utilities common in CAD/survey drafting workflows, ;;; but the code, command name and file name here are new and are ;;; NOT copied from, nor identical to, any specific third-party ;;; product. ;;; ;;; --------------------------------------------------------------------- ;;; Developed and shared for the CAD community by: BGol Community ;;; Community website: https://bgol.in/ ;;; License: Open-source & free to use, modify, and share for all. ;;; Provided "as is", without warranty of any kind. ;;; --------------------------------------------------------------------- (vl-load-com) (defun BGOL:PLEN-EnsureLayer (lname / ) (if (not (tblsearch "LAYER" lname)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 lname) '(70 . 0) '(62 . 5) ; blue '(6 . "Continuous"))) ) ) (defun BGOL:PLEN-MakeText (pt str ht lname / dxfdata) (setq dxfdata (list '(0 . "TEXT") '(100 . "AcDbEntity") (cons 8 lname) '(100 . "AcDbText") (cons 10 pt) (cons 40 ht) (cons 1 str) ) ) (entmakex dxfdata) ) (defun BGOL:PLEN-GetLen (obj / res) (setq res (vl-catch-all-apply '(lambda () (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))) '())) (if (vl-catch-all-error-p res) 0.0 res) ) (defun C:PLEN ( / ss n i ename obj layer len entry layertotals pt th rowht row grandtotal k) (BGOL:PLEN-EnsureLayer "BGOL-PLEN") (princ "\nSelect lines/polylines to total by layer: ") (setq ss (ssget '((-4 . "")))) (if ss (progn (setq n (sslength ss)) (setq layertotals '()) (setq grandtotal 0.0) (setq i 0) (while (< i n) (setq ename (ssname ss i)) (setq obj (vlax-ename->vla-object ename)) (setq layer (cdr (assoc 8 (entget ename)))) (setq len (BGOL:PLEN-GetLen obj)) (setq grandtotal (+ grandtotal len)) (setq entry (assoc layer layertotals)) (if entry (setq layertotals (subst (cons layer (+ (cdr entry) len)) entry layertotals)) (setq layertotals (append layertotals (list (cons layer len)))) ) (setq i (1+ i)) ) (setq pt (getpoint "\nSpecify point for results table: ")) (if pt (progn (setq th 2.5) (setq rowht (* th 1.8)) (setq row (list (car pt) (cadr pt) (caddr pt))) (BGOL:PLEN-MakeText row "LAYER LENGTH SUMMARY (PLEN)" th "BGOL-PLEN") (setq row (list (car row) (- (cadr row) rowht) (caddr row))) (BGOL:PLEN-MakeText row "Layer Total Length" th "BGOL-PLEN") (setq k 0) (foreach entry layertotals (setq row (list (car row) (- (cadr row) rowht) (caddr row))) (BGOL:PLEN-MakeText row (strcat (car entry) " " (rtos (cdr entry) 2 3)) th "BGOL-PLEN") (setq k (1+ k)) ) (setq row (list (car row) (- (cadr row) rowht) (caddr row))) (BGOL:PLEN-MakeText row (strcat "GRAND TOTAL: " (rtos grandtotal 2 3)) th "BGOL-PLEN") (princ (strcat "\nPLEN: totals for " (itoa (length layertotals)) " layer(s) placed in drawing.")) ) (princ "\nNo point specified; table not placed.") ) ) (princ "\nNo lines or polylines selected.") ) (princ) ) (princ "\nPLLENTAB-bgol.lsp loaded. Type PLEN to total selected line lengths by layer.") (princ "\n -- Free & open-source, courtesy of BGol Community (https://bgol.in/) --") (princ)