;;; --------------------------------------------------------------------------- ;;; GanttChart.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; GANTT CHART - A TWELVE MONTH PROGRAMME BAR CHART ;;; ;;; PURPOSE ;;; Draws a construction programme as a bar chart: a task name column down the ;;; left, twelve months across the top, and a coloured bar per task spanning ;;; from its start date to its finish. ;;; ;;; Drawn as ordinary AutoCAD geometry, so it plots as part of the drawing set ;;; and lives on the sheet with everything else - which is the whole point of ;;; doing it here rather than in a scheduling package. ;;; ;;; THE MONTHS ARE SCALED BY THEIR REAL LENGTH ;;; This is the good idea in the routine this came from and it is worth saying ;;; plainly: the twelve columns are NOT equal. Each month is as wide as its own ;;; number of days, so the horizontal scale is genuinely linear in time. ;;; ;;; That means a bar drawn from 20 March to 10 April is the right length, and ;;; measuring across the chart gives real durations. Equal-width months, which ;;; is what most hand-drawn charts use, quietly distort every bar that crosses ;;; a month boundary. ;;; ;;; February takes 28 or 29 days depending on whether you say it is a leap ;;; year, and the whole scale adjusts with it. ;;; ;;; THE YEAR CAN START ANYWHERE ;;; Pick the month the programme starts in and the twelve columns are rotated ;;; to begin there - a job running August to July reads left to right without ;;; wrapping. ;;; ;;; GANTTCHART - draw a twelve month programme bar chart ;;; --------------------------------------------------------------------------- ;;; --------------------------------------------------------------------------- ;;; THE CALENDAR ;;; --------------------------------------------------------------------------- (setq GanttChart:Months '(("January" . 31) ("February" . 28) ("March" . 31) ("April" . 30) ("May" . 31) ("June" . 30) ("July" . 31) ("August" . 31) ("September" . 30) ("October" . 31) ("November" . 30) ("December" . 31))) ;;; The calendar rotated to start at a given month, with February corrected for ;;; a leap year. Returned as ( name . days ) pairs in drawing order. (defun GanttChart:Calendar ( startIdx leap / out i n ) (setq out nil i 0 n (length GanttChart:Months)) (repeat n (setq out (cons (nth (rem (+ startIdx i) n) GanttChart:Months) out) i (1+ i))) (setq out (reverse out)) (if leap (mapcar '(lambda (m) (if (= (car m) "February") (cons (car m) 29) m)) out) out) ) ;;; --------------------------------------------------------------------------- ;;; SESSION MEMORY ;;; --------------------------------------------------------------------------- (if (null *GanttChart:Prefs*) (setq *GanttChart:Prefs* (list (cons "WIDTH" 32.500) ; overall chart width (cons "HEIGHT" 20.750) ; overall chart height (cons "NAMEW" 8.000) ; task name column width (cons "HEADH" 1.875) ; header band height (cons "MONTHH" 1.000) ; month name row within the header (cons "ROWH" 0.375) ; one task row (cons "TASKTXT" 0.250) ; task name text height (cons "MONTXT" 0.1875) ; month name text height (cons "BARW" 0.250) ; bar width (cons "START" "January") (cons "LEAP" "No") (cons "FILL" "Filled") (cons "COLOUR" "White") ) ) ) (defun GanttChart:Get ( key ) (cdr (assoc key *GanttChart:Prefs*))) (defun GanttChart:Put ( key val ) (setq *GanttChart:Prefs* (cons (cons key val) (vl-remove-if '(lambda (p) (= (car p) key)) *GanttChart:Prefs*))) val ) (defun GanttChart:Ask ( key prompt / v ) (initget 6) (setq v (getdist (strcat "\n " prompt " <" (rtos (GanttChart:Get key) 2 4) ">: "))) (if v (GanttChart:Put key v) (GanttChart:Get key)) ) ;;; --------------------------------------------------------------------------- ;;; DRAWING HELPERS ;;; --------------------------------------------------------------------------- (defun GanttChart:P ( org x y ) (list (+ (car org) x) (+ (cadr org) y) 0.0)) (defun GanttChart:Line ( org pts close ) (command "_.LINE") (foreach p pts (command (GanttChart:P org (car p) (cadr p)))) (if close (command "_C") (command "")) (princ) ) (defun GanttChart:Layer ( name ) (if (tblsearch "layer" name) (command "_.LAYER" "_ON" name "_THAW" name "_UNLOCK" name "") (command "_.LAYER" "_NEW" name "")) (setvar "CLAYER" name) ) ;;; Ask for one of a list of keywords and return its zero-based index. (defun GanttChart:PickFrom ( prompt names default / kw answer ) (setq kw "") (foreach n names (setq kw (strcat kw " " n))) (initget 0 (substr kw 2)) (setq answer (getkword (strcat prompt " <" default ">: "))) (if (null answer) (setq answer default)) ;; Position of the answer, found by how much of the list remains after it. (- (length names) (length (member answer names))) ) ;;; --------------------------------------------------------------------------- ;;; MAIN COMMAND ;;; --------------------------------------------------------------------------- (defun c:GANTTCHART ( / *error* vars vals org opt W H nameW headH monthH rowH taskTxt monTxt barW leap startIdx cal names days total incr yTop yHead yDiv barLeft barW2 run x0 x1 mid m maxRows row task colour tmp sMon sDay eMon eDay startX endX rowMid offsets acc ) (setq vars '("CMDECHO" "OSMODE" "BLIPMODE" "CLAYER" "CECOLOR" "FILLMODE" "PLINEWID") vals (mapcar 'getvar vars)) (defun GanttChart:Restore ( ) (mapcar 'setvar vars vals) (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End")) (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '()) (princ) ) (defun *error* ( msg ) (GanttChart:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** GANTTCHART error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) ;; AutoCAD 2015 and later refuse (command) inside an *error* handler ;; unless the routine says up front that it will use one. Restore does, ;; to close this undo group. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") ;; --- chart setup -------------------------------------------------------- (initget "Size Draw") (setq opt (getkword "\nGantt chart [Size/Draw] : ")) (if (= opt "Size") (progn (GanttChart:Ask "WIDTH" "Overall chart width") (GanttChart:Ask "HEIGHT" "Overall chart height") (GanttChart:Ask "NAMEW" "Task name column width") (GanttChart:Ask "ROWH" "Task row height") (GanttChart:Ask "TASKTXT" "Task text height") (GanttChart:Ask "BARW" "Bar width"))) (setq W (GanttChart:Get "WIDTH") H (GanttChart:Get "HEIGHT") nameW (GanttChart:Get "NAMEW") headH (GanttChart:Get "HEADH") monthH (GanttChart:Get "MONTHH") rowH (GanttChart:Get "ROWH") taskTxt (GanttChart:Get "TASKTXT") monTxt (GanttChart:Get "MONTXT") barW (GanttChart:Get "BARW")) ;; Which month the programme starts in, and whether the year is a leap year. (setq names (mapcar 'car GanttChart:Months)) (setq startIdx (GanttChart:PickFrom "\nMonth the programme starts in" names (GanttChart:Get "START"))) (GanttChart:Put "START" (nth startIdx names)) (initget "Yes No") (setq opt (getkword (strcat "\nLeap year [Yes/No] <" (GanttChart:Get "LEAP") ">: "))) (if opt (GanttChart:Put "LEAP" opt)) (setq leap (= (GanttChart:Get "LEAP") "Yes")) (initget "Filled Open") (setq opt (getkword (strcat "\nBars [Filled/Open] <" (GanttChart:Get "FILL") ">: "))) (if opt (GanttChart:Put "FILL" opt)) (cond ((>= nameW W) (princ "\n** The name column is wider than the chart. **")) ((<= (- H headH) rowH) (princ "\n** No room for any task rows below the header. **")) ((null (setq org (getpoint "\nBottom-left corner of the chart: "))) (princ "\nCancelled.")) (t (setvar "OSMODE" 0) (setvar "BLIPMODE" 0) (setvar "FILLMODE" (if (= (GanttChart:Get "FILL") "Filled") 1 0)) (setq cal (GanttChart:Calendar startIdx leap) days (mapcar 'cdr cal) total (apply '+ days) ;; The horizontal scale: chart units per day, across the bar ;; area only. Everything about the timeline follows from this. incr (/ (- W nameW) (float total)) yTop H yHead (- H headH) yDiv (+ yHead monthH) maxRows (fix (/ yHead rowH))) (GanttChart:Layer "GANTT") (setvar "CECOLOR" "7") ;; --- frame and columns ------------------------------------------- (GanttChart:Line org (list '(0 0) (list W 0) (list W H) (list 0 H)) t) (GanttChart:Line org (list (list nameW 0) (list nameW yTop)) nil) (GanttChart:Line org (list (list 0 yHead) (list W yHead)) nil) (GanttChart:Line org (list (list nameW yDiv) (list W yDiv)) nil) ;; --- month columns, each as wide as its own days ----------------- ;; The running total is kept so each month's start offset is ;; recorded; the task bars are set out from those same offsets, so ;; the bars and the headings cannot disagree. (setq acc 0.0 offsets nil) (foreach m cal (setq x0 (+ nameW (* acc incr)) acc (+ acc (cdr m)) x1 (+ nameW (* acc incr)) mid (/ (+ x0 x1) 2.0) offsets (cons x0 offsets)) ;; Column rule, full height of the bar area. (setvar "CECOLOR" "7") (GanttChart:Line org (list (list x1 0) (list x1 yDiv)) nil) ;; Month name, centred in its own column. (setvar "CECOLOR" "2") (command "_.TEXT" "_J" "_MC" (GanttChart:P org mid (+ yHead (/ monthH 2.0))) monTxt 0 (car m))) (setq offsets (reverse offsets)) (setvar "CECOLOR" "7") ;; --- tasks ------------------------------------------------------- (princ (strcat "\nRoom for " (itoa maxRows) " tasks. Enter a blank name to finish.")) (setq row 0 colour (GanttChart:Get "COLOUR") run t) (while (and run (< row maxRows)) (setq task (substr (getstring 1 "\nTask name: ") 1 40)) (if (= task "") (setq run nil) (progn (initget 0 "White Yellow Blue Green Red Cyan Magenta") (setq tmp (getkword (strcat "\nBar colour <" colour ">: "))) (if tmp (setq colour tmp)) (GanttChart:Put "COLOUR" colour) ;; Start and finish, each a month and a day within it. (setq sMon (GanttChart:PickFrom "\n Start month" (mapcar 'car cal) (car (nth 0 cal)))) (initget 6) (setq sDay (getint (strcat "\n Start day [1-" (itoa (cdr (nth sMon cal))) "]: "))) (if (null sDay) (setq sDay 1)) (setq sDay (max 1 (min sDay (cdr (nth sMon cal))))) (setq eMon (GanttChart:PickFrom "\n Finish month" (mapcar 'car cal) (car (nth sMon cal)))) (initget 6) (setq eDay (getint (strcat "\n Finish day [1-" (itoa (cdr (nth eMon cal))) "]: "))) (if (null eDay) (setq eDay (cdr (nth eMon cal)))) (setq eDay (max 1 (min eDay (cdr (nth eMon cal))))) (setq startX (+ (nth sMon offsets) (* (1- sDay) incr)) endX (+ (nth eMon offsets) (* eDay incr)) rowMid (- yHead (* rowH (+ row 0.5)))) (if (<= endX startX) (princ "\n ** Finish is not after the start - bar skipped. **") (progn (setvar "CECOLOR" colour) ;; Task name, right-justified against the column ;; rule and vertically centred on its own bar. (command "_.TEXT" "_J" "_MR" (GanttChart:P org (- nameW (* taskTxt 0.5)) rowMid) taskTxt 0 task) ;; The bar itself. A wide polyline rather than the ;; legacy TRACE the original used - it obeys ;; FILLMODE the same way and can be edited after. (command "_.PLINE" (GanttChart:P org startX rowMid) "_W" barW barW (GanttChart:P org endX rowMid) "") (setvar "CECOLOR" "7") (setq row (1+ row)))))) ) (if (>= row maxRows) (princ (strcat "\n** The chart is full at " (itoa maxRows) " tasks. Increase the height, or reduce the row" " height, for more. **"))) (princ (strcat "\nGantt chart drawn - " (itoa row) " task(s), " (nth startIdx names) " onward, " (itoa total) " days across " (rtos (- W nameW) 2 3) " units.")) ) ) (GanttChart:Restore) (princ) ) (princ)