;;; ==================================================================
;;;  DCD-IIC-EN.LSP  -  add up the length of the selected objects
;;;  Institute of Information Technology in Civil Engineering (IIC)
;;;  Hanoi University of Civil Engineering
;;;  https://iic.huce.edu.vn  -  Tel: 0989 427 809
;;; ------------------------------------------------------------------
;;;  Three commands:
;;;    TCD     select objects, print the total length at the command line
;;;    TCDT    as above, then write the figure on the drawing as text
;;;    TCDL    add up each layer separately and print a table
;;;
;;;  Why this file is needed: LIST reads one object at a time and
;;;  MEASUREGEOM measures one object per run. To know the total length
;;;  of 300 pipe runs you would have to add them up by hand, and adding
;;;  up by hand goes wrong.
;;;
;;;  How it works: vlax-curve-getDistAtParam at the curve's end
;;;  parameter. That function works for every kind of curve, so there
;;;  is no separate code for lines, arcs, polylines, ellipses or splines.
;;;
;;;  FOUR THINGS TO KNOW BEFORE RUNNING - the files circulating online
;;;  do not mention them:
;;;    1. TWO LINES LYING ON TOP OF EACH OTHER are counted TWICE. The
;;;       program has no idea they coincide. Run OVERKILL to remove
;;;       duplicate linework first, or the total comes out too high.
;;;    2. CIRCLES and ELLIPSES are measured by CIRCUMFERENCE. If you
;;;       only want the straight runs, take them out using the
;;;       breakdown table the command prints.
;;;    3. OBJECTS INSIDE BLOCKS ARE NOT COUNTED. Only what sits
;;;       directly in the drawing is added. Explode the blocks first,
;;;       or measure one and multiply by the number of insertions.
;;;    4. A POLYLINE WITH WIDTH is still measured along its CENTRELINE,
;;;       not its edges. Right for pipework, wrong for a wall drawn as
;;;       a wide polyline.
;;;  After running, the command PRINTS a breakdown by object type, so
;;;  the figure can be checked instead of taken on trust.
;;;
;;;  Units: the figure is in DRAWING UNITS. A drawing in millimetres
;;;  gives millimetres. The command also prints the figure divided by
;;;  1000, to read off metres at a glance.
;;;
;;;  Command names were checked before being chosen: the acad.pgp alias
;;;  file of the 2027 release has no TCD, TCDT or TCDL.
;;;
;;;  To load: type APPLOAD, pick this file, click Load.
;;;  Saved as UTF-8. If you edit it in Notepad, save it back as UTF-8.
;;; ==================================================================

(vl-load-com)

;;; ------------------------------------------------------------------
;;;  Length of ONE object. Returns nil when the object is not a curve
;;;  (text, hatch, block...).
;;; ------------------------------------------------------------------
(defun iic-len (e / p)
  (if (and e (not (vl-catch-all-error-p
                    (setq p (vl-catch-all-apply
                              'vlax-curve-getEndParam (list e))))))
    (if p
      (vl-catch-all-apply 'vlax-curve-getDistAtParam (list e p))
    )
  )
)

;;; ------------------------------------------------------------------
;;;  Collect a selection set into (type . (count . total_length))
;;; ------------------------------------------------------------------
(defun iic-collect (ss / i e kind d tbl o skip)
  (setq tbl nil skip 0 i 0)
  (while (< i (sslength ss))
    (setq e    (ssname ss i)
          kind (cdr (assoc 0 (entget e)))
          d    (iic-len e))
    (if (and d (numberp d))
      (progn
        (setq o (assoc kind tbl))
        (if o
          (setq tbl (subst (cons kind (cons (1+ (cadr o)) (+ (cddr o) d)))
                           o tbl))
          (setq tbl (cons (cons kind (cons 1 d)) tbl))
        )
      )
      (setq skip (1+ skip))
    )
    (setq i (1+ i))
  )
  (cons tbl skip)
)

;;; ------------------------------------------------------------------
;;;  Print the breakdown and the total. Returns the total length.
;;; ------------------------------------------------------------------
(defun iic-print (tbl skip / total)
  (setq total 0.0)
  (princ "\n")
  (princ "\n  Object type              Count         Length")
  (princ "\n  ---------------------------------------------")
  (foreach o (reverse tbl)
    (setq total (+ total (cddr o)))
    (princ (strcat "\n  " (iic-pad (car o) 20)
                   (iic-rpad (itoa (cadr o)) 8)
                   (iic-rpad (rtos (cddr o) 2 2) 15)))
  )
  (princ "\n  ---------------------------------------------")
  (princ (strcat "\n  TOTAL" (iic-rpad (rtos total 2 2) 38)))
  (princ (strcat "\n  Divided by 1000" (iic-rpad (rtos (/ total 1000.0) 2 3) 28)))
  (if (> skip 0)
    (princ (strcat "\n  Skipped " (itoa skip)
                   " object(s) with no length (text, hatch, block...)"))
  )
  (princ "\n")
  total
)

;;; pad on the right to width n
(defun iic-pad (s n)
  (while (< (strlen s) n) (setq s (strcat s " ")))
  s
)
;;; pad on the left to width n
(defun iic-rpad (s n)
  (while (< (strlen s) n) (setq s (strcat " " s)))
  s
)

;;; ------------------------------------------------------------------
;;;  TCD - add up and print at the command line
;;; ------------------------------------------------------------------
(defun c:TCD (/ ss r)
  (princ "\nSelect the objects to add up: ")
  (setq ss (ssget))
  (if ss
    (progn
      (setq r (iic-collect ss))
      (iic-print (car r) (cdr r))
    )
    (princ "\nNothing selected.")
  )
  (princ)
)

;;; ------------------------------------------------------------------
;;;  TCDT - add up, then write the result on the drawing
;;; ------------------------------------------------------------------
(defun c:TCDT (/ ss r total p h txt)
  (princ "\nSelect the objects to add up: ")
  (setq ss (ssget))
  (if ss
    (progn
      (setq r     (iic-collect ss)
            total (iic-print (car r) (cdr r)))
      (setq p (getpoint "\nPick where to put the text: "))
      (if p
        (progn
          (setq h (getvar "TEXTSIZE"))
          (if (or (null h) (<= h 0)) (setq h 2.5))
          (setq txt (strcat "Total length = " (rtos total 2 2)))
          (entmake (list (cons 0 "TEXT")
                         (cons 10 p)
                         (cons 40 h)
                         (cons 1 txt)))
          (princ (strcat "\nWritten: " txt))
        )
      )
    )
    (princ "\nNothing selected.")
  )
  (princ)
)

;;; ------------------------------------------------------------------
;;;  TCDL - add up layer by layer
;;; ------------------------------------------------------------------
(defun c:TCDL (/ ss i e lay d tbl o total skip)
  (princ "\nSelect the objects to add up by layer: ")
  (setq ss (ssget))
  (if ss
    (progn
      (setq tbl nil skip 0 i 0)
      (while (< i (sslength ss))
        (setq e   (ssname ss i)
              lay (cdr (assoc 8 (entget e)))
              d   (iic-len e))
        (if (and d (numberp d))
          (progn
            (setq o (assoc lay tbl))
            (if o
              (setq tbl (subst (cons lay (cons (1+ (cadr o)) (+ (cddr o) d)))
                               o tbl))
              (setq tbl (cons (cons lay (cons 1 d)) tbl))
            )
          )
          (setq skip (1+ skip))
        )
        (setq i (1+ i))
      )
      (setq total 0.0)
      (princ "\n")
      (princ "\n  Layer                    Count         Length")
      (princ "\n  ---------------------------------------------")
      (foreach o (reverse tbl)
        (setq total (+ total (cddr o)))
        (princ (strcat "\n  " (iic-pad (car o) 20)
                       (iic-rpad (itoa (cadr o)) 8)
                       (iic-rpad (rtos (cddr o) 2 2) 15)))
      )
      (princ "\n  ---------------------------------------------")
      (princ (strcat "\n  TOTAL" (iic-rpad (rtos total 2 2) 38)))
      (if (> skip 0)
        (princ (strcat "\n  Skipped " (itoa skip) " object(s) with no length"))
      )
      (princ "\n")
    )
    (princ "\nNothing selected.")
  )
  (princ)
)

(princ "\nDCD-IIC-EN loaded. Commands: TCD (print), TCDT (write as text), TCDL (by layer).")
(princ)