EDITTABLE command

acaddoc.lsp

@@ -150,9 +150,8 @@ themselves after first run."
             ("dumpstairs.lsp" "DUMPSTAIRS")
             ("dumplands.lsp" "DUMPLANDS")
             ("editblock.lsp" "EDITBLOCK")
-            ("editmaterial.lsp" "EDITMATERIAL")
-            ("edithardware.lsp" "EDITHARDWARE")
             ("editfinish.lsp" "EDITFINISH")
+            ("edittable.lsp" "EDITTABLE")
             ("embed.lsp" "EMBED")
             ("embed-totals.lsp" "EMBED-TOTALS")
             ("endview.lsp" "ENDVIEW")

commands/edittable.lsp

@@ -0,0 +1,23 @@
+(psc-include '("dialog/dialog.lsp"
+               "fab/util.lsp"))
+
+(defun-q c:edittable (/ cell table col-names title)
+  "Edits the description of an item in a material or hardware table.
+
+In a material table, this command also updates the item weight."
+  (setq cell (get-table-cell))
+  (if (not cell) (error "No table selected"))
+  (setq table (pop! 'cell)
+        col-names (get-table-column-names table)
+        title (get-table-title table))
+  (cond ((= title "Material")
+         ((lambda(/ row row-ht)
+            (if (not (member "description" col-names))
+                (error "No description column found"))
+            (mat-table-update-desc table (car cell) (get-material)))))
+        ((= title "Hardware")
+         ((lambda(/ hardware desc-col)
+            (if (not (member "desc" col-names))
+                (error "No desc column found"))
+            (vla-SetText table (car cell) (vl-position "desc" col-names) (get-hardware)))))))
+(defun-r 'c:edittable)

fab/hardware.dcl

@@ -20,28 +20,5 @@ hardware : dialog {
     height = 30;
   }
 
-  : row {
-    
-    : edit5_box {
-      label = "Qty";
-      key = "qty";
-      fixed_width = true;
-      width = 10;
-    }
-
-    : edit_box {
-      label = "Description";
-      key = "desc";
-      is_enabled = false;
-      fixed_width = true;
-      width = 50;
-    }
-  }
-
-  : toggle {
-    label = "Ship loose";
-    key = "sl";
-  }
-
   save_cancel;
 }

fab/material.dcl

@@ -21,58 +21,6 @@ material : dialog {
     height = 30;
   }
 
-  : row {
-    : edit12_box {
-      label = "Mark";
-      key = "mark";
-      fixed_width = true;
-      width = 25;
-    }
-
-    : edit12_box {
-      label = "Qty";
-      key = "qty";
-      fixed_width = true;
-      width = 25;
-    }
-  }
-
-  : row {
-    : edit12_box {
-      label = "Width";
-      key = "width";
-      fixed_width = true;
-      width = 25;
-    }
-
-    : edit12_box {
-      label = "Length";
-      key = "length";
-      fixed_width = true;
-      width = 25;
-    }
-  }
-
-  : edit_box {
-    label = "Description";
-    key = "desc";
-    is_enabled = false;
-  }
-
-  : boxed_row {
-    label = "Notes";
-
-    : toggle {
-      label = "Ship loose";
-      key = "sl";
-    }
-
-    : toggle {
-      label = "Laser cut";
-      key = "lc";
-    }
-  }
-
   save_cancel;
 }
 

fab/util.lsp

@@ -341,19 +341,25 @@ Similarity is based on equivalence of the values of all keys in KEYS."
           data-lists))
 (defun-r 'fab-combine-like-data)
 
-(defun-q calc-weight-formula (description / line wt wt-type)
+(defun-q calc-weight-formula (table row / desc line wt wt-type col-names letters col)
   "Returns the weight formula for a material description"
-  (declare (vars (description str)))
+  (declare (vars (table vla-object (table-p table))
+                 (row int)))
+  (setq col-names (get-table-column-names table)
+        description (vla-GetText table row (vl-position "description" col-names)))
   (setq line (assoc description (read-csv "fab/material.csv")))
   (if (not line) (error (strcat "Weight formula not found: " description)))
-  (setq wt (nth 1 line)
+  (defun col (name)
+    (strcat (chr (vl-string-elt letters (vl-position name col-names))) (to-string (1+ row))))
+  (setq letters "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+        wt (nth 1 line)
         wt-type (nth 2 line))
   (cond ((= wt-type "sqft")
-         (strcat "=(B#*D#*E#/144)*" wt))
+         (strcat "=(" (col "qty") "*" (col "length") "*" (col "width") "/144)*" wt))
         ((= wt-type "foot")
-         (strcat "=(B#*E#/12)*" wt))
+         (strcat "=(" (col "qty") "*" (col "length") "/12)*" wt))
         ((= wt-type "each")
-         (strcat "=B#*" wt))))
+         (strcat "=" (col "qty") "*" wt))))
 (defun-r 'calc-weight-formula)
 
 (defun-q next-mark-prefix (/ job-dir filename file mark ret increment-mark )
@@ -462,4 +468,92 @@ Returns VALUE if successful or nil if no finish table found"
   "Returns the finish from the finish table or nil if no finish table found"
   (setq table (get-table-by-title "Finish"))
   (if table (vla-GetText table 1 0)))
-(defun-r 'set-finish)
+(defun-r 'get-finish)
+
+(defun-q get-material (/
+                        matlst
+                        ;; variables defined here for dialog-init
+                        defaults-file
+                        popup-keys
+                        dist-keys
+                        int-keys
+                        toggle-keys
+                        plain-string-keys
+                        default-actions
+                        dialog-ties
+                        sub-dialogs
+                        ;; variables included here for scope,
+                        ;; but not defined here directly
+                        extra-keys
+                        tile-actions
+                       )
+  "Prompts the user to choose a material description via dialog and returns it"
+  (setq matlst (read-csv "fab/material.csv")
+        toggle-keys '("show_all")
+        default-actions '(("category" . update-material)
+                          ("show_all" . update-material))
+        popup-keys (list (append '("category"
+                                   "All")
+                                 (uniquify (mapcar '(lambda(x) (nth 4 x)) matlst)))
+                         '("material" . current-material)))
+
+  ;; calculate value of material box
+  (defun current-material ( / cat mlst)
+    (setq cat (dialog-popup-val "category")
+          mlst matlst)
+    (if (= (get_tile "show_all") "0")
+        (remove! 'mlst '(= (nth 3 x) "xtra")))
+    (if (not (= cat "All"))
+        (remove! 'mlst '(not (= (nth 4 x) cat))))
+    (mapcar 'car mlst))
+
+  (xd-value "material" (dialog-init "fab/material.dcl" "material" nil)))
+(defun-r 'get-material)
+
+(defun-q get-hardware (/
+                        ;; variables defined here for dialog-init
+                        defaults-file
+                        popup-keys
+                        dist-keys
+                        int-keys
+                        toggle-keys
+                        plain-string-keys
+                        default-actions
+                        dialog-ties
+                        sub-dialogs
+                        ;; variables included here for scope,
+                        ;; but not defined here directly
+                        extra-keys
+                        tile-actions
+                        )
+  "Prompts the user to choose a hardware description via dialog and returns it"
+  (setq hdwlst (read-csv "fab/hardware.csv")
+        toggle-keys '("show_all")
+        default-actions '(("category" . update-hardware)
+                          ("show_all" . update-hardware))
+        popup-keys (list (append '("category"
+                                   "All")
+                                 (uniquify (mapcar 'cadddr hdwlst)))
+                         '("hardware" . current-hardware)))
+  
+  ;; calculate value of hardware box
+  (defun current-hardware ( / cat hlst)
+    (setq cat (dialog-popup-val "category")
+          hlst hdwlst)
+    (if (= (get_tile "show_all") "0")
+        (remove! 'hlst '(= (nth 2 x) "xtra")))
+    (if (not (= cat "All"))
+        (remove! 'hlst '(not (= (nth 3 x) cat))))
+    (mapcar 'car hlst))
+
+  ;; update hardware list box
+  (defun update-hardware (k v / )
+    (dialog-popup-list-update "hardware"))
+  
+  (xd-value "hardware" (dialog-init "fab/hardware.dcl" "hardware" nil)))
+(defun-r 'get-hardware)
+
+(defun-q get-finish ()
+  "Prompts the user to choose a finish description via dialog and returns it"
+  nil)
+(defun-r 'get-finish)

util/object/table.lsp

@@ -7,6 +7,7 @@ operations.")
 
 (defun-q table-p (obj)
   "Returns T if OBJ is a table"
+  (declare (vars (obj vla-object)))
   (= "AcDbTable" (vla-get-ObjectName obj)))
 (defun-r 'table-p)
 
@@ -32,6 +33,12 @@ wildcards wcmatch accepts will work here."
   ret)
 (defun-r 'get-table-by-title)
 
+(defun-q get-table-title (table)
+  "Returns the contents of cell 0,0"
+  (declare (vars (table vla-object (table-p table))))
+  (vla-GetText table 0 0))
+(defun-r 'get-table-title)
+
 (defun-q pt-in-table-p (pt table / minpt maxpt min-x max-x min-y max-y x y)
   "Returns T if PT is within TABLE's bounding box"
   (declare (vars (pt list (point-p pt))
@@ -45,9 +52,13 @@ wildcards wcmatch accepts will work here."
   (foreach row (range 0 (vla-get-Rows table) 1)
     (foreach col (range 0 (vla-get-Columns table) 1)
       (add-to-list 'ret (list row col)))))
+(defun-r 'table-cells)
 
 (defun-q get-table-cell-bounding-box (table row col / extents)
   "Returns the bounding box for the cell as a list of the for (minpt maxpt)"
+  (declare (vars (table vla-object (table-p table))
+                 (row int)
+                 (col int)))
   (setq extents (3-item-list
                  (vlax-safearray->list
                   (vlax-variant-value
@@ -75,7 +86,36 @@ If so, it returns a list of the form (table row column)."
                 (cons table cell)))
          (table-cells table))))))
 
-(defun-q parse-table (table / gettext empty-first-col format-col-name header-row rows ncols cols)
+(defun-q format-table-column-name (name)
+  "Returns NAME as lowercase with spaces replaced by underscores"
+  (declare (vars (name str)))
+  (string-subst-all "_" " " (lowercase name)))
+(defun-r 'format-table-column-name)
+
+(defun-q empty-first-column-p (table row)
+  "Returns T if column 0 of ROW is empty"
+  (declare (vars (table vla-object (table-p table))
+                 (row int)))
+  (= (vla-GetText table row 0) ""))
+(defun-r 'empty-first-column-p)
+
+(defun-q get-table-header-row (table)
+  "Returns the index of the row containing the column headers"
+  (declare (vars (table vla-object (table-p table))))
+  (if (empty-first-column-p table 1) 2 1))
+(defun-r 'get-table-header-row)
+
+(defun-q get-table-column-names (table / header-row)
+  "Returns the column names as a list of formatted strings
+
+Strings are formatted by %format-table-column-name"
+  (declare (vars (table vla-object (table-p table))))
+  (setq header-row (get-table-header-row table))
+  (mapcar '(lambda(col) (format-table-column-name (vla-GetText table header-row col)))
+          (range 0 (vla-get-Columns table) 1)))
+(defun-r 'get-table-column-names)
+
+(defun-q parse-table (table / gettext header-row rows cols)
   "Returns the data in TABLE as a list of data lists
 
 Each list item corresponse to a row. The keys of the datalists correspond to the column
@@ -87,45 +127,19 @@ the table title at 0,0. The second row is considered the header row and column n
 from this row."
   (declare (vars (table vla-object (table-p table))))
   (defun gettext (nrow ncol) (vla-GetText table nrow ncol))
-  (defun empty-first-col (nrow) (= (gettext nrow 0) ""))
-  (defun format-col-name (name) (string-subst-all "_" " " (lowercase name)))
-  (setq header-row (if (empty-first-col 1) 2 1)
+  (setq header-row (get-table-header-row table)
         rows (range (1+ header-row) (vla-get-Rows table) 1)
-        ncols (range 0 (vla-get-Columns table) 1)
-        cols (mapcar '(lambda(ncol) (format-col-name (gettext header-row ncol)))
-                     ncols))
+        cols (get-table-column-names table))
   (strip-nil
    (mapcar
     '(lambda(nrow)
       (if (not (empty-first-col nrow))
           (mapcar '(lambda(col-name ncol) (list col-name (gettext nrow ncol)))
-                  cols ncols)))
+                  cols
+                  (range 0 (vla-get-Columns table) 1))))
     rows)))
 (defun-r 'parse-table)
 
-:|
-
-(defun-q table-row-extents (table row / tl br tmp)
-  "Returns the extents of a row in TABLE
-
-The return value is a 2-item list in the form '(top-left-pt bot-right-pt)."
-  (declare (vars (table vla-object (table-p table))
-                 (row int)))
-  (setq tmp (vlax-safearray->list
-	     (vlax-variant-value (vla-GetCellExtents table row 0 :vlax-false)))
-        tl (list (car tmp)
-                 (cadr tmp)
-                 (caddr tmp))
-        tmp (- (vla-get-Columns table) 1)
-        tmp (vlax-safearray->list
-	     (vlax-variant-value (vla-GetCellExtents table row tmp :vlax-false))))
-  (repeat 3 (setq tmp (cdddr tmp)))
-  (setq br (list (car tmp)
-                 (cadr tmp)
-                 (caddr tmp)))
-  (list tl br))
-(defun-r 'table-row-extents)
-
 (defun-q table-insert-rows (table nrows before / title rowht tbls2move lastrow)
   "Inserts NROWS rows in a fab drawing TABLE before row BEFORE
 
@@ -152,6 +166,43 @@ If there are other fab tables below this one, move them down to accomodate."
   (vla-InsertRows table before rowht nrows))
 (defun-r 'table-insert-rows)
 
+(defun-q mat-table-fix-row-height (table row orig-ht / base-ht ass-table)
+  "Constrains the row height to multiples of ORIG-HT
+
+If row height has changed from ORIG-HT, moves hardware/assembly tables as necessary"
+  (declare (vars (table vla-object (table-p table))
+                 (row int)
+                 (orig-ht real)))
+  (setq i 1
+        base-ht (vla-GetRowHeight mat-table 0)
+        ass-table (get-table-by-title "Assembly*"))
+  (while (> (- (vla-GetRowHeight mat-table row) (* base-ht i)) 0.1)
+         (vla-SetRowHeight mat-table row (* orig-ht (inc! 'i)))
+         (if ass-table
+             (progn
+               (vla-Move ass-table (3dpt 0 0) (3dpt 0 (- orig-ht)))
+               (vla-Move (get-table-by-title "Hardware") (3dpt 0 0) (3dpt 0 (- orig-ht)))
+               (vla-Move (get-table-by-title "Finish") (3dpt 0 0) (3dpt 0 (- orig-ht)))))))
+(defun-r 'mat-table-fix-row-height)
+
+(defun-q mat-table-update-desc (mat-table row desc / row-ht)
+  "Updates the description column at ROW with DESC
+
+If present, line weight and each weight are updated."
+  (declare (vars (table vla-object (table-p table))
+                 (row int)
+                 (desc str)))
+  (setq weight-col (vl-position "weight" (get-table-column-names table))
+        row-ht (vla-GetRowHeight table row))
+  (vla-SetText table row (vl-position "description" col-names) desc)
+  (mat-table-fix-row-height table row row-ht)
+  (if weight-col
+      (progn
+        (vla-SetText table row weight-col
+                     (string-subst-all (to-string (1+ row)) "#" (calc-weight-formula mat-table row)))
+        (vla-SetCellFormat table row weight-col "%lu2%pr1"))))
+(defun-r 'mat-table-update-desc)
+
 (defun-q mat-table-update-marks (+- n at / prefix row rows mark marks)
   "Update fab mark numbers in material table and callouts
 
@@ -205,52 +256,6 @@ list of data lists representing row data."
   (vla-put-RegenerateTableSuppressed mat-table :vlax-false))
 (defun-r 'mat-table-add-data)
 
-(defun-q mat-table-set-row (mat-table row data / cols row-ht last-row i)
-  "Sets a ROW in MAT-TABLE
-
-ROW is a row index and DATA is a data list whose keys correspond to the table columns."
-  (declare (vars (mat-table vla-object (table-p mat-table))
-                 (row int (>= row 0))
-                 (data nil (data-list-p data))))
-  (setq row-ht (vla-GetRowHeight mat-table 0)
-        last-row (1- (vla-get-Rows mat-table))
-        cols '(mark qty desc width length weight note))
-  ;; overwrite weight formula with correct row number
-  (subst! (list "weight" (string-subst-all (to-string (1+ row))
-                                           "#"
-                                           (cadr (assoc "weight" data))))
-          (assoc "weight" data)
-          'data)
-  ;; unlock description and weight
-  (vla-SetCellState mat-table row 2 acCellStateNone)
-  (vla-SetCellState mat-table row 5 acCellStateNone)
-  ;; write the row
-  (foreach col cols
-           (if (setq col (assoc (lowercase (to-string col)) data))
-               (vla-SetText mat-table
-                            row
-                            (vl-position (read (car col)) cols)
-                            (cadr col))))
-  ;; lock description and weight
-  (vla-SetCellState mat-table row 2 acCellStateContentLocked)
-  (vla-SetCellState mat-table row 5 acCellStateContentLocked)
-  ;; ensure weight has correct format
-  (vla-SetCellFormat mat-table row 5 "%lu2%pr1")
-  ;; reset row height in case it changed
-  (vla-SetRowHeight mat-table row row-ht)
-  (setq i 1)
-  (while (> (- (vla-GetRowHeight mat-table row) (* row-ht i)) 0.1)
-    (vla-SetRowHeight mat-table row (* row-ht (inc! 'i)))
-    (foreach table (mapcar 'get-table-by-title '("Hardware"
-                                                 "Assembly*"
-                                                 "Finish"))
-             (if table
-                 (vla-Move table (3dpt 0 0) (3dpt 0 (- row-ht))))))
-  ;; update weight sums
-  (vla-SetText mat-table last-row 4 (strcat "=sum(F3:F" (to-string last-row) ")"))
-  (mat-table-update-ea-wt mat-table))
-(defun-r 'mat-table-set-row)
-
 (defun-q mat-table-update-ea-wt (mat-table / at lastrow formula)
   "Updates the formula for \"each weight\" in MAT-TABLE to include any added rows"
   (declare (vars (mat-table vla-object (table-p mat-table))))
@@ -293,62 +298,3 @@ QTY-COL is the index of the quantities column."
          (if (> qty 0) (vla-SetText table i qty-col (to-string (/ qty n))))))
 (defun-r 'table-divide-qty)
 
-(defun-q hdw-table-set-row (hdw-table row data / cols row-ht)
-  "Sets a ROW in HDW-TABLE
-
-ROW is a row index and DATA is a data list whose keys correspond to the table columns."
-  (declare (vars (hdw-table vla-object (table-p hdw-table))
-                 (row int (>= row 0))
-                 (data nil (data-list-p data))))
-  (setq row-ht (vla-GetRowHeight hdw-table 0)
-        cols '(qty desc note))
-  ;; unlock description
-  (vla-SetCellState hdw-table row 1 acCellStateNone)
-  ;; write the row
-  (foreach col cols
-           (if (setq col (assoc (lowercase (to-string col)) data))
-               (vla-SetText hdw-table
-                            row
-                            (vl-position (read (car col)) cols)
-                            (cadr col))))
-  ;; reset row height in case it changed
-  (vla-SetRowHeight hdw-table row row-ht)
-  ;; lock description
-  (vla-SetCellState hdw-table row 1 acCellStateContentLocked))
-(defun-r 'hdw-table-set-row)
-
-(defun-q hdw-table-add-data (before datas / n row)
-  "Adds bulk data to hardware table
-
-BEFORE is the row to add data at. The special symbol 'end means the last row. DATAS is a
-list of data lists representing row data."
-  (declare (vars (before nil (or (= before 'end)
-                                 (= (type before) 'int)))
-                 (datas list (vl-every 'data-list-p datas))))
-  (if (= before 'end)
-      (setq before (vla-get-Rows hdw-table)))
-  (setq n (length datas)
-        row before)
-  (table-insert-rows hdw-table n before)
-  (vla-put-RegenerateTableSuppressed hdw-table :vlax-true)
-  (foreach data datas
-           (hdw-table-set-row hdw-table row data)
-           (inc! 'row))
-  (vla-put-RegenerateTableSuppressed hdw-table :vlax-false))
-(defun-r 'hdw-table-add-data)
-
-(defun-q gsl-mat-table-set-row (gsl-mat-table row data / cols row-ht)
-  "Sets a ROW in a generic ship loose template table
-
-ROW is a row index and DATA is a data list whose keys correspond to the table columns."
-  (declare (vars (gsl-mat-table vla-object (table-p gsl-mat-table))
-                 (row int (>= row 0))
-                 (data nil (data-list-p data))))
-  (setq cols '(mark qty desc width length note))
-  (foreach col cols
-           (if (setq col (assoc (lowercase (to-string col)) data))
-               (vla-SetText gsl-mat-table
-                            row
-                            (+ 4 (vl-position (read (car col)) cols))
-                            (cadr col)))))
-(defun-r 'gsl-mat-table-set-row)