Code Red > AutoLISP (Vanilla / Visual)

Text to Table Cells

(1/2) > >>

DeeGeeCees_V.2.0:
Hi all, long time no see. :) I hope everyone is doing well.

I'm searching for a way to populate cells with text from a dialog box using LISP (and DCL).  I'm dealing with legacy data and old ways, which consist of these parameters:


* These will be REVISION schedules as AutoCad Tables
* There are multiple "copied" tables
* Tables are all in ModelSpace
What I'm looking to accomplish:


* Dialog Box with entries for REV | Date | Description | User
* Find all tables with REVISION in the Header
* Populate text into cells in each table instance, first available cell in each column, respectively
It's been quite some time since I've done anything LISP related, but I'm familiar with it as well as DCL. I would be eternally grateful if someone could point me the right direction to get this started. I'll even buy you a beer.

DeeGeeCees_V.2.0:
Here's what I was able to cobble together with some help from the kind folks over at the AD Forums. It works, but if there's no "-" it loops continually. I'm thinking it has something to do with the while loop in tr3-4:


--- Code: ---;;;;;;;;;;;;;;;;;;;;;;;;;;;;;T-REV

(defun c:t-rev () ;(/ tblss row rows vals txtval e i n s x ans rev1 descr1 column)
(tr3-5)
(up-dater)
(tr3-1)
(tr3-2)
)

(defun tr3-1 ()
(setq tblss (ssget  "x" (list(cons -4 "<AND")
  (cons 0 "ACAD_TABLE")  
  (cons -4 "<AND")
  (cons 1  "REVISION"); <-- case sensitive column header
  (cons -4 "AND>")
  (cons 410  (getvar "CTAB")); <-- current layout name
  (cons -4 "AND>")
  )))
)

(defun tr3-2 ()
    (if (/= tblss nil)
        (progn
            (setq i 0
                  n (sslength tblss)
            )
            (while (< i n)
                (setq e (ssname tblss i)
                      x (cdr (assoc 0 (entget e)))
                      i (1+ i)
                )
                (tr3-3)
                (tr3-4)
            )
        )
    )
    (princ)
)

(defun tr3-3 ()
(setq table (vlax-ename->vla-object e))
(setq columns (vlax-get-property table 'Columns))
(setq rows (vlax-get-property table 'rows))
)


(defun tr3-4 ()
(setq row 1)   ; 0 is header
(while (/= rows nil)
    (setq column 0)
    (setq txtval (vlax-invoke-method table 'GetText row column )); now we have value from first cell in row.
    (if (= txtval "-")
(progn         
    (vla-settext table row column rev1)
            (setq column (1+ column))
            (vla-settext table row column datetext)
            (setq column (1+ column))
            (vla-settext table row column descr1)
            (setq column (1+ column))
            (vla-settext table row column "PD")
            (setq column (1+ column))
            (vla-settext table row column "-")
    (setq txtval nil)
    (setq rows nil)
    )
(setq row (1+ row ))
    )
)
)


(defun tr3-5 ()
(setq ans (AH:getvalsm (list "Add Revision " "REV " 6 5 "" "DESCRIPTION " 40 40 "")))
(setq rev1 (car ans))
(setq descr1 (cadr ans))
)

(defun UP-DATER ()
(setq d (rtos (getvar "CDATE") 2 6)
     ;get the date and time and convert to text
          yr (substr d 3 2)
  ;extract the year
          mo (substr d 5 2)
  ;extract the month
         day (substr d 7 2)
;extract the day
     );setq
(setq datetext (strcat mo "/" day "/" yr))
)


(defun AH:getvalsm (dcllst / x y num fo fname keynum key_lst v_lst)
  (setq num (/ (- (length dcllst) 1) 4))
  (setq x 0)
  (setq y 0)
  (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
  (write-line "ddgetvalAH : dialog {" fo)
  (write-line (strcat " label =" (chr 34) (nth 0 dcllst) (chr 34) " ;") fo)
  (write-line " : column {" fo)
  (write-line " width =25;" fo)
  (repeat num
    (write-line "spacer_1 ;" fo)
    (write-line ": edit_box {" fo)
    (setq keynum (strcat "key" (rtos (setq y (+ Y 1)) 2 0)))
    (write-line (strcat "    key = " (chr 34) keynum (chr 34) ";") fo)
    (write-line (strcat " label = " (chr 34) (nth (+ x 1) dcllst) (chr 34) ";") fo)
    (write-line (strcat "     edit_width = " (rtos (nth (+ x 2) dcllst) 2 0) ";") fo)
    (write-line (strcat "     edit_limit = " (rtos (nth (+ x 3) dcllst) 2 0) ";") fo)
    (write-line "   is_enabled = true ;" fo)
    (write-line "   allow_accept=true ;" fo)
    (write-line "    }" fo)
    (setq x (+ x 4))
  )
  (write-line "    }" fo)
  (write-line "spacer_1 ;" fo)
  (write-line "ok_cancel;}" fo)
  (close fo)

  (setq dcl_id (load_dialog fname))
  (if (not (new_dialog "ddgetvalAH" dcl_id))
    (exit)
  )
  (setq x 0)
  (setq y 0)
  (setq v_lst '())
  (repeat num
    (setq keynum (strcat "key" (rtos (setq y (+ Y 1)) 2 0)))
    (setq key_lst (cons keynum key_lst))
    (set_tile keynum (nth (setq x (+ x 4)) dcllst))
   ; (mode_tile keynum 3)
  )
    (mode_tile "key1" 2)
  (action_tile "accept" "(mapcar '(lambda (x) (setq v_lst (cons (get_tile x) v_lst))) key_lst)(done_dialog)")
  (action_tile "cancel" "(done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete fname)

  (princ v_lst)
)
--- End code ---

BIGAL:
Please add my name to the multi getvals code ; By Alan H Feb 2019 info@Alanh.com.au

You do not need the code to live inside your program you can use (if (not AH:getvalsm)(load "Multi Getvals.lsp")) the Multi getvals needs to be saved in a support path or add the directory location. (load "c:\\myprograms\\lispstuff\\Multi Getvals.lsp") etc.

There are Multi toggles, Multi radio buttons also some with up to 3 columns of variables.

DeeGeeCees_V.2.0:

--- Quote from: BIGAL on September 21, 2023, 08:06:21 PM ---Please add my name to the multi getvals code ; By Alan H Feb 2019 info@Alanh.com.au

You do not need the code to live inside your program you can use (if (not AH:getvalsm)(load "Multi Getvals.lsp")) the Multi getvals needs to be saved in a support path or add the directory location. (load "c:\\myprograms\\lispstuff\\Multi Getvals.lsp") etc.

There are Multi toggles, Multi radio buttons also some with up to 3 columns of variables.

--- End quote ---

10-4, I will absolutely include your name!

This is still a WIP for me, and although I used to be knowledgeable with LISP, I'm a beginner again. I grabbed a portion of your code that worked for what I need and I'm still trying to make sense of it all.

I'm mostly trying to work out why it loops if there's no "-" in the first column of a given table.

DeeGeeCees_V.2.0:
 :-)

A thousand pardons, good sir.


--- Code: ---;;;;;;;;;;;;;;;;;;;;;;;;;;;;;T-REV

(defun c:Rev-Update () ;(/ tblss row rows vals txtval e i n s x ans rev1 descr1 column)
(tr3-5)
(up-dater)
(logname1)
(tr3-1)
(tr3-2)
)

(defun tr3-1 ()
(setq tblss (ssget  "x" (list(cons -4 "<AND")
  (cons 0 "ACAD_TABLE")  
  (cons -4 "<AND")
  (cons 1  "REVISION"); <-- case sensitive column header
  (cons -4 "AND>")
  (cons 410  (getvar "CTAB")); <-- current layout name
  (cons -4 "AND>")
  )))
)

(defun tr3-2 ()
    (if (/= tblss nil)
        (progn
            (setq i 0
                  n (sslength tblss)
            )
            (while (< i n)
                (setq e (ssname tblss i)
                      x (cdr (assoc 0 (entget e)))
                      i (1+ i)
                )
                (tr3-3)
                (tr3-4)
            )
        )
    )
    (princ)
)

(defun tr3-3 ()
(setq table (vlax-ename->vla-object e))
(setq columns (vlax-get-property table 'Columns))
(setq rows (vlax-get-property table 'rows))
)


(defun tr3-4 ()
(setq row 1)   ; 0 is header
(while (/= rows nil)
    (setq column 0)
    (setq txtval (vlax-invoke-method table 'GetText row column )); now we have value from first cell in row.
    (if (= txtval "-")
(progn         
    (vla-settext table row column rev1)
            (setq column (1+ column))
            (vla-settext table row column datetext)
            (setq column (1+ column))
            (vla-settext table row column descr1)
            (setq column (1+ column))
            (vla-settext table row column eng1)
            (setq column (1+ column))
            (vla-settext table row column "-")
    (setq txtval nil)
    (setq rows nil)
    )
(setq row (1+ row ))
    )
)
)


(defun tr3-5 ()
(setq ans (AH:getvalsm (list "Add Revision " "REV " 6 5 "" "DESCRIPTION " 40 40 "")))
(setq rev1 (car ans))
(setq descr1 (cadr ans))
)

(defun UP-DATER ()
(setq d (rtos (getvar "CDATE") 2 6)
     ;get the date and time and convert to text
          yr (substr d 3 2)
  ;extract the year
          mo (substr d 5 2)
  ;extract the month
         day (substr d 7 2)
;extract the day
     );setq
(setq datetext (strcat mo "/" day "/" yr))
)

(defun logname1 () 
(setq eng1 (getvar "loginname"))
(if (= eng1 "patrickdonnelly")
    (setq eng1 "PD")
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Multi Getvals Code: By Alan H Feb 2019 info@Alanh.com.au ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun AH:getvalsm (dcllst / x y num fo fname keynum key_lst v_lst)
  (setq num (/ (- (length dcllst) 1) 4))
  (setq x 0)
  (setq y 0)
  (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
  (write-line "ddgetvalAH : dialog {" fo)
  (write-line (strcat " label =" (chr 34) (nth 0 dcllst) (chr 34) " ;") fo)
  (write-line " : column {" fo)
  (write-line " width =25;" fo)
  (repeat num
    (write-line "spacer_1 ;" fo)
    (write-line ": edit_box {" fo)
    (setq keynum (strcat "key" (rtos (setq y (+ Y 1)) 2 0)))
    (write-line (strcat "    key = " (chr 34) keynum (chr 34) ";") fo)
    (write-line (strcat " label = " (chr 34) (nth (+ x 1) dcllst) (chr 34) ";") fo)
    (write-line (strcat "     edit_width = " (rtos (nth (+ x 2) dcllst) 2 0) ";") fo)
    (write-line (strcat "     edit_limit = " (rtos (nth (+ x 3) dcllst) 2 0) ";") fo)
    (write-line "   is_enabled = true ;" fo)
    (write-line "   allow_accept=true ;" fo)
    (write-line "    }" fo)
    (setq x (+ x 4))
  )
  (write-line "    }" fo)
  (write-line "spacer_1 ;" fo)
  (write-line "ok_cancel;}" fo)
  (close fo)

  (setq dcl_id (load_dialog fname))
  (if (not (new_dialog "ddgetvalAH" dcl_id))
    (exit)
  )
  (setq x 0)
  (setq y 0)
  (setq v_lst '())
  (repeat num
    (setq keynum (strcat "key" (rtos (setq y (+ Y 1)) 2 0)))
    (setq key_lst (cons keynum key_lst))
    (set_tile keynum (nth (setq x (+ x 4)) dcllst))
   ; (mode_tile keynum 3)
  )
    (mode_tile "key1" 2)
  (action_tile "accept" "(mapcar '(lambda (x) (setq v_lst (cons (get_tile x) v_lst))) key_lst)(done_dialog)")
  (action_tile "cancel" "(done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete fname)

  (princ v_lst)
)
--- End code ---

Navigation

[0] Message Index

[#] Next page