Table lisp file

July 4, 2023

Apologies if there is already a lisp somewhere on the site, is there anyway to produce a table is AutoCAD by selecting numerous numbers/dimensions in text into one column then another column showing the difference between the numbers?

At the moment I input the numbers into Excel and use autosum to show the difference then copy and paste into CAD.

See attached drawing of what I am trying to explain.

Again any help is much appreciated.

Ash

Example.dwg

July 4, 2023

Busy day so will answer in a couple of parts, but the first answer is yes, sort of, it is all out there in the wilds of the internet

This first part will make a table (modified from https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-table/td-p/7821821 )

(defun InsTable ( refs / ss name ref refs insPt table row) ; refs: List item for each row
  (vl-load-com)
  (or *acdoc*
    (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )

  (setq insPt (trans (getpoint "\nInsertion point: ") 1 0))
  (setq table (vla-addtable
                (vla-get-modelspace *acdoc*)
                (vlax-3d-point insPt)
                (+ 2 (length refs))	; number of rows (including title and header)
;;                3			; number of colums
                2			; number of colums
                20			; cell height
                80			; row width
              )
  )
  (vla-put-VertCellMargin table 4.0)
  (vla-put-TitleSuppressed table :vlax-false)
  (vla-put-HeaderSuppressed table :vlax-false)
  (vla-setText table 0 0 "Blocks")
  (vla-setText table 1 0 "Name")
  (vla-setText table 1 1 "Count")
;;  (vla-setText table 1 2 "Symbol")
  (setq row 2)
  (foreach item refs ;; to adjust this later to make up a table
    (vla-settext table row 0 (nth 0 item)) ; remake this as another foreach loop for columns / number of items in row list, refs
    (vla-settext table row 1 (nth 1 item))
;;    (vla-settext table row 2 (nth 2 item))
    (setq row (1+ row))
  ) ; end foreach
  (princ)
)

As an example, this will make a simple table from above - only set up just now for 3 columns, and needs some tidying up, but I think this is the first part you want - have a look and see if you can adjust it to suit your needs

(instable (list '("Row 1" "Column 2" "Column 3") '("Row 2" "Column 2" "Column 3") '("Row 3" "Column 2" "Column 3") ))

All that needs is to create the line above from selecting appropriate texts - will come back to this later

Edited July 4, 2023 by Steven P

July 4, 2023

Thanks Steven, I will have a go at this.

July 4, 2023

2nd part... this will make a list of texts which will be the entry for 'row 1' above

(defun c:TextList ( / ss eov entlist texts Mytext)
  (defun EntorValue ( MSG / EndLoop sel MyEnt MyValue enta entb pt)
    (princ MSG)
    (setq MyValue "")
    (setq MyEnt (list))
    (setq EndLoop "No")
    (while (= EndLoop "No")
      (setq grsel (grread nil 4 2))
      (setq sela (car grsel))
      (if (or (= sela 2)(= sela 3) ) ; text entry or mouse click
        (setq sel (nth 1 grsel))
      )
      (if (= (type sel) 'LIST)
        (progn
          (setq MyEnt (nentselp sel))
          (if (= nil MyEnt)
            (Princ "\nMissed! Try again. Select text or enter a value: ")
            (setq EndLoop "Yes")
          ) ; end if
        ) ; end progn
        (progn ; for text entry
          (if (= sel 13) ; enter
            (progn
              (setq EndLoop "Yes")
            ) ; end progn
          ) ; end if
        ) ; end progn
      ) ; end if list
    ) ; end while
    (if ( = (length MyEnt) 0)
      (progn
        MyValue
      ) ; end progn
      (progn
        ;;GetEnt code
        (setq enta (car MyEnt))
        (setq pt (cdr (assoc 10 (entget enta))) )
        ;;fix for nenset or entsel requirements
        (setq entb (last (last (nentselp pt)))) ;; use sel?
        (if (and (/= entb nil) (/= (type entb) 'real) )
          (progn
            (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION,*LEADER")(setq enta entb))
          )
        )
        (setq MyEnt enta)
        MyEnt
      ) ; end progn
    ) ; end if
  ) ; end defun

  (setq texts (list))
  (while (/= (setq eOv (entorvalue "\nSelect Text or exit")) "")
(princ eOv)
    (if (= (type eOv) 'ENAME)
      (progn
        (setq entlist (entget eOv))
        (if (= (cdr (assoc 0 entlist)) "DIMENSION")(setq Mytext (cdr (assoc 42 entlist))) )
        (if (or (= (cdr (assoc 0 entlist)) "TEXT")(= (cdr (assoc 0 entlist)) "MTEXT"))
          (setq Mytext (cdr (assoc 1 entlist)))
        )
        (setq texts (append texts (list Mytext)))
      ) ; end progn
      (progn
      ) ; end progn
  ) ; end if
  ) ; end while

  texts ; return texts list
)

July 4, 2023

Thanks again - I will have a play with it tonight but I'm probably way over my head!

July 4, 2023

17 minutes ago, ASH71 said:

Thanks again - I will have a play with it tonight but I'm probably way over my head!

No problem, busy day here today so just throwing things up there. Have a go and see where you get to - it all makes sense -to me-

I'll see if I can add in the last part you'll need later and then all you need to do is add it all together

July 4, 2023

Have a go at what you can but try this. Command is gaps (change to suit your self)

Will need some thinking to get the table formatting - not something I usually do a lot with. I am thinking at the end of gaps it creates this table the simplest solution might be create the table and then modify it.

I have put in some table formatting stuff for you to play with, enjoy

(defun c:gaps ( / textlist tablelist smaller larger)
  (setq textlist (c:TextList))                    ; runs c:TextList to select numbers
;;The result from (c:TextList) is saved as a list, textlist


  (setq tablelist (list (list "Hole Diameter" "" "Centres")))  ; Table Header Row detail
;;tablelist is a list for each row in the table. Above is for the header row.
;;The number of items in this defines row the table columns
;; Text goes in between "..." and blank columns are ""




  (setq smaller (car textlist)) ; Get the first number in textlist (the 'smaller' one)
  (setq acount 1)               ; a counter
  (while (< acount (length textlist) )   ; loop through the texts
    (setq larger (nth acount textlist))  ; getrthe second number ('larger')
    (setq difference (- (atof larger) (atof smaller))) ; minus. atof: the texts are strings not numbers
    (setq tablelist (append tablelist    ; append to the tablelist results list


;; These 2 lines populate the table data list
      (list (list smaller "" ""))           ; add in the smaller number in te first column, the other 2 columns are ""
      (list (list "" "" (rtos difference))) ; add the next row for difference. RTOS since result is a number not string



    )) ; 
    (setq smaller larger)       ; make the larger number now the smaller number
    (setq acount (+ acount 1))  ; increase the counter
  ) ; end while                 ; end the while loop
  (setq tablelist (append tablelist (list (list smaller "" "")) ))  ;add in the last row, the last larger number
                                ;Remember to keep this foramt as 'smaller' above
  (UnsTable tablelist)          ; create the table using the list tablelist for the row data
tablelist
)
(defun UnsTable ( refs / ss name ref insPt table row acounter MyColumns) ; refs: List item for each row ; just a typo
  (vl-load-com) ; load vl- functions

;;this function used 'refs' as the data for each line


  (setq MyColumns (length (car refs))) ; work out number of colums based on 1st data list in refs
  (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))) ) ; get document reference
  (setq insPt (trans (getpoint "\nInsertion point: ") 1 0)) ; ask user for insert point
  (setq table (vla-addtable             ; add table
                (vla-get-modelspace *acdoc*) ; put it in modelspace
                (vlax-3d-point insPt)   ; at this insertion point
                (+ 2 (length refs))	; number of rows (including title and header)
                MyColumns		; number of colums
                220			; cell height
                1200			; row width
              )
  )

;;;Formatting
;;;Cell margins
  (vla-put-horzcellmargin table 4.0)
  (vla-put-VertCellMargin table 4.0)

;;override column widths
  (vla-setcolumnwidth table 1 500)

;; Set the text height for the Title, Header and Data rows
  (vla-SetTextHeight table acTitleRow 187.5)
  (vla-SetTextHeight table (+ acDataRow acHeaderRow) 125)

;; Set the text style
  (vla-SetTextStyle table (+ acDataRow acHeaderRow acTitleRow) "Standard")

;;; Set the alignment for the Data, Header, and Title rows ; have to do individually?
  (vla-SetAlignment table acHeaderRow acMiddleCenter)
  (vla-SetAlignment table acTitleRow acMiddleCenter)
  (vla-SetAlignment table acDataRow acMiddleCenter) ; top middle bottom : left centre right

;;; Table Colours
;;; Odd colours used as deonstration for the method
  (setq col (vla-get-truecolor table))
  (vla-put-colormethod col acColorMethodByRGB)
  (vla-SetRGB col 225 220 225)
  (vla-SetBackgroundColor table (+ acTitleRow acHeaderRow) col)
  (vla-SetRGB col 250 250 245)
  (vla-SetBackgroundColor table acDataRow col)  ; data row background colours - full row
  (vla-SetRGB col 250 250 250)
  (vla-SetGridColor table (+ acHorzTop acHorzInside) acDataRow col) ; grid colours

  (vla-put-TitleSuppressed table :vlax-false)
  (vla-put-HeaderSuppressed table :vlax-false)
;;End formatting



;;These limes populate the table
;;Example:  (vla-setText table Row Column Text) ;;'table' from a setq above


;;This line is the table title, "Holes"
  (vla-setText table 0 0 "Holes") ; table title ; set in column 0, row 0 (LISP count from as the first number)


  (setq row 1) ; a counter, assuning header row is sent with refs data, the first data row is row 1

;;Loop through the list of text selected 
  (foreach item refs ; loop through rows
    (setq acounter 0) ; a counter for columns
    (while (< acounter MyColumns) ; loop through columns (number defined by 1st in data ref.)



;;write the text to the cell
      (vla-settext table row acounter (nth acounter item)) ; set cell data


      (setq acounter (+ acounter 1))
    )
    (setq row (1+ row))
  ) ; end foreach


  (princ)

)
(defun c:TextList ( / ss eov entlist texts Mytext)
  (defun EntorValue ( MSG / EndLoop sel MyEnt MyValue enta entb pt)
    (princ MSG)
    (setq MyValue "")
    (setq MyEnt (list))
    (setq EndLoop "No")
    (while (= EndLoop "No")
      (setq grsel (grread nil 4 2))
      (setq sela (car grsel))
      (if (or (= sela 2)(= sela 3) ) ; text entry or mouse click
        (setq sel (nth 1 grsel))
      )
      (if (= (type sel) 'LIST)
        (progn
          (setq MyEnt (nentselp sel))
          (if (= nil MyEnt)
            (Princ "\nMissed! Try again. Select text or enter a value: ")
            (setq EndLoop "Yes")
          ) ; end if
        ) ; end progn
        (progn ; for text entry
          (if (= sel 13) ; enter
            (progn
              (setq EndLoop "Yes")
            ) ; end progn
          ) ; end if
        ) ; end progn
      ) ; end if list
    ) ; end while
    (if ( = (length MyEnt) 0)
      (progn
        MyValue
      ) ; end progn
      (progn
        ;;GetEnt code
        (setq enta (car MyEnt))
        (setq pt (cdr (assoc 10 (entget enta))) )
        ;;fix for nenset or entsel requirements
        (setq entb (last (last (nentselp pt)))) ;; use sel?
        (if (and (/= entb nil) (/= (type entb) 'real) )
          (progn
            (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION,*LEADER")(setq enta entb))
          )
        )
        (setq MyEnt enta)
        MyEnt
      ) ; end progn
    ) ; end if
  ) ; end defun

  (setq texts (list))
  (while (/= (setq eOv (entorvalue "\nSelect Text or exit: ")) "")
    (if (= (type eOv) 'ENAME)
      (progn
        (setq entlist (entget eOv))
        (if (= (cdr (assoc 0 entlist)) "DIMENSION")(setq Mytext (cdr (assoc 42 entlist))) )
        (if (or (= (cdr (assoc 0 entlist)) "TEXT")(= (cdr (assoc 0 entlist)) "MTEXT"))
          (setq Mytext (cdr (assoc 1 entlist)))
        )
        (princ Mytext)
        (setq texts (append texts (list Mytext)))
      ) ; end progn
      (progn
      ) ; end progn
  ) ; end if
  ) ; end while

  texts ; return texts list
)

Edited July 5, 2023 by Steven P

July 4, 2023

Another example for a table. This modifies the width and height of the cells, the numbers are large as it was done as a response to a post.

defun c:mktblexample ( / )

(setq txtht 120)
(setq row 3 col 3)
(Setq curspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))

(setq sp (vlax-3d-point (getpoint "pick a point for table ")))

(setq objtable (vla-addtable curspace sp row col 200 500))
(vla-SetTextHeight Objtable acDataRow txtht)
(vla-SetTextHeight Objtable acHeaderRow (* txtht 1.2))
(vla-SetTextHeight Objtable acTitleRow (* txtht 1.5))
(vla-put-VertCellMargin Objtable (* txtht 0.5))
(vla-put-HorzCellMargin Objtable (* txtht 0.5))
(vla-Setcolumnwidth Objtable 0 1800)
(vla-Setcolumnwidth Objtable 1 1800)
(vla-Setcolumnwidth Objtable 2 1800)
(vla-SetTextHeight custObj acDataRow txtht)
(vla-SetTextHeight custObj acHeaderRow (* txtht 1.2))
(vla-SetTextHeight custObj acTitleRow (* txtht 1.5))
(vla-SetAlignment Objtable (+ acDataRow acHeaderRow acTitleRow)  acMiddleCenter)
(vla-settext objtable 0 0 "LENGTH TABLE")
(vla-settext objtable 1 0 "Length")
(vla-settext objtable 1 1 "Count")
(vla-settext objtable 1 2 "Layer name")
(princ)
)

next step is use insertrows to add more rows

(vla-insertrows objtable  numrows  txtht 1) ; add 1 row 

(vla-settext objtable numrows 0  (rtos val 2 0))

July 5, 2023

Thanks Lads, appreciate all your help!

Ash

July 5, 2023

20 hours ago, Steven P said:

Have a go at what you can but try this. Command is gaps (change to suit your self)

Will need some thinking to get the table formatting - not something I usually do a lot with. I am thinking at the end of gaps it creates this table the simplest solution might be create the table and then modify it.

I have put in some table formatting stuff for you to play with, enjoy

(defun c:gaps ( / textlist tablelist smaller larger)
  (setq textlist (c:TextList))  ; runs c:TextList to select numbers
  (setq tablelist (list (list "Hole Diameter" "" "Centres")))  ; Make table header row
  (setq smaller (car textlist)) ; Get the first number (the 'smaller' one)
  (setq acount 1)               ; a counter
  (while (< acount (length textlist) )   ; loop through the texts
    (setq larger (nth acount textlist))  ; getrthe second number ('larger')
    (setq difference (- (atof larger) (atof smaller))) ; minus. atof: the texts are strings not numbers
    (setq tablelist (append tablelist    ; append to the tablelist results list
      (list (list smaller "" ""))           ; add in the smaller number ; adds in blank column
      (list (list "" "" (rtos difference))) ; add the next row for difference. RTOS since result is a number not string
    )) ; 
    (setq smaller larger)       ; make the larger number now the smaller number
    (setq acount (+ acount 1))  ; increase the counter
  ) ; end while                 ; end the while loop
  (setq tablelist (append tablelist (list (list smaller "" "")) ))  ;add in the last row, the last larger number
                                ;Remember to keep this foramt as 'smaller' above
  (UnsTable tablelist)          ; create the table
tablelist
)

(defun UnsTable ( refs / ss name ref refs insPt table row) ; refs: List item for each row ; just a typo
  (vl-load-com) ; load vl- functions

  (setq MyColumns (length (car refs))) ; work out number of colums based on 1st data list in refs
  (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))) ) ; get document reference
  (setq insPt (trans (getpoint "\nInsertion point: ") 1 0)) ; ask user for insert point
  (setq table (vla-addtable             ; add table
                (vla-get-modelspace *acdoc*) ; put it in modelspace
                (vlax-3d-point insPt)   ; at this insertion point
                (+ 2 (length refs))	; number of rows (including title and header)
                MyColumns		; number of colums
                220			; cell height
                1200			; row width
              )
  )

;;Formatting
;;Cell margins
  (vla-put-horzcellmargin table 4.0)
  (vla-put-VertCellMargin table 4.0)

;;override column widths
  (vla-setcolumnwidth table 1 500)

;; Set the text height for the Title, Header and Data rows
  (vla-SetTextHeight table acTitleRow 187.5)
  (vla-SetTextHeight table (+ acDataRow acHeaderRow) 125)

;; Set the text style
  (vla-SetTextStyle table (+ acDataRow acHeaderRow acTitleRow) "Standard")

;; Set the alignment for the Data, Header, and Title rows ; have to do individually?
  (vla-SetAlignment table acHeaderRow acMiddleCenter)
  (vla-SetAlignment table acTitleRow acMiddleCenter)
  (vla-SetAlignment table acDataRow acMiddleCenter) ; top middle bottom : left centre right

;; colours
  (vla-SetRGB col 225 225 225)
  (vla-SetBackgroundColor table (+ acTitleRow acHeaderRow) col)
  (vla-SetRGB col 50 50 50)
  (vla-SetBackgroundColor table acDataRow col)
  (vla-SetRGB col 244 0 0) ; data row background colours
  (vla-SetGridColor table (+ acHorzTop acHorzInside) acDataRow col) ; grid colours

  (vla-put-TitleSuppressed table :vlax-false)
  (vla-put-HeaderSuppressed table :vlax-false)
;;End formatting

  (vla-setText table 0 0 "Holes") ; table title
  (setq row 1) ; assuning header row is sent with refs data
  (foreach item refs ; loop through rows
    (setq acounter 0)
    (while (< acounter MyColumns) ; loop through columns (number defined by 1st in data ref.)
      (vla-settext table row acounter (nth acounter item)) ; set cell data
      (setq acounter (+ acounter 1))
    )
    (setq row (1+ row))
  ) ; end foreach
  (princ)

)






(defun c:TextList ( / ss eov entlist texts Mytext)
  (defun EntorValue ( MSG / EndLoop sel MyEnt MyValue enta entb pt)
    (princ MSG)
    (setq MyValue "")
    (setq MyEnt (list))
    (setq EndLoop "No")
    (while (= EndLoop "No")
      (setq grsel (grread nil 4 2))
      (setq sela (car grsel))
      (if (or (= sela 2)(= sela 3) ) ; text entry or mouse click
        (setq sel (nth 1 grsel))
      )
      (if (= (type sel) 'LIST)
        (progn
          (setq MyEnt (nentselp sel))
          (if (= nil MyEnt)
            (Princ "\nMissed! Try again. Select text or enter a value: ")
            (setq EndLoop "Yes")
          ) ; end if
        ) ; end progn
        (progn ; for text entry
          (if (= sel 13) ; enter
            (progn
              (setq EndLoop "Yes")
            ) ; end progn
          ) ; end if
        ) ; end progn
      ) ; end if list
    ) ; end while
    (if ( = (length MyEnt) 0)
      (progn
        MyValue
      ) ; end progn
      (progn
        ;;GetEnt code
        (setq enta (car MyEnt))
        (setq pt (cdr (assoc 10 (entget enta))) )
        ;;fix for nenset or entsel requirements
        (setq entb (last (last (nentselp pt)))) ;; use sel?
        (if (and (/= entb nil) (/= (type entb) 'real) )
          (progn
            (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION,*LEADER")(setq enta entb))
          )
        )
        (setq MyEnt enta)
        MyEnt
      ) ; end progn
    ) ; end if
  ) ; end defun

  (setq texts (list))
  (while (/= (setq eOv (entorvalue "\nSelect Text or exit: ")) "")
    (if (= (type eOv) 'ENAME)
      (progn
        (setq entlist (entget eOv))
        (if (= (cdr (assoc 0 entlist)) "DIMENSION")(setq Mytext (cdr (assoc 42 entlist))) )
        (if (or (= (cdr (assoc 0 entlist)) "TEXT")(= (cdr (assoc 0 entlist)) "MTEXT"))
          (setq Mytext (cdr (assoc 1 entlist)))
        )
        (princ Mytext)
        (setq texts (append texts (list Mytext)))
      ) ; end progn
      (progn
      ) ; end progn
  ) ; end if
  ) ; end while

  texts ; return texts list
)

Hi Steven, I had a little play around with this during my lunch. I can alter the sizes of the table columns and widths and the height of the text that goes in them, I'm not clever eough to work out how to get the numbers I select on the drawing to co into the columns - any pointers for me please?

July 5, 2023

OK - something isn't working quite right in the formatting (it was when I tested it yesterday - must had had something hanging about that I hadn't noticed) - I'll fix it and edit here to let you know

EDIT:

I've updated the code above, I'd taken out a line last night for the cell colours, forgot to add it back in again (but in testing my CAD had that line loaded into it so never noticed, whoops!)

It should be good to go now - have a look, work it out and then shout to say what changes you want - bigAls post has a lot of good formatting stuff in there too

Edited July 5, 2023 by Steven P

July 5, 2023

36 minutes ago, Steven P said:

OK - something isn't working quite right in the formatting (it was when I tested it yesterday - must had had something hanging about that I hadn't noticed) - I'll fix it and edit here to let you know

EDIT:

I've updated the code above, I'd taken out a line last night for the cell colours, forgot to add it back in again (but in testing my CAD had that line loaded into it so never noticed, whoops!)

It should be good to go now - have a look, work it out and then shout to say what changes you want - bigAls post has a lot of good formatting stuff in there too

That is spot on! Exactly what I was looking for! Gonna have a play around at home tonight - try and learn a bit.

Thanks again lads

Ash

July 5, 2023

No problem, shout if you need anything more - always happy to help if your happy to look at what I did!

July 6, 2023

Just a comment a Table is like a Dim and has a massive amount of properties you can change, a handy one if your making a big table speed becomes a problem as it draws the table but a trick is you can turn off Table regen make the table then turn table regen back on the difference is like 5 minutes vs 5 seconds.

list of methods for a table.txt

July 11, 2023

Sorry to bring this back up but I was wondering if you could teach me how to change something in the table. I've tweaked the columns and text height, can you show me how to change the lisp to that it asks what I want the table to be called - e.g. at the moment it is called DRILLING (see example attached). I want to be able to type in the specific name I need prior to the table being inserted. Hope that makes sense.

Example1.dwg

July 11, 2023

I think I'll give you some hints and reckon you can work it out from there?

Somewhere near the beginning of the LISP you want to ask what to call the table, perhaps after you have selected all the numbers, so here is a function in there, unstable (yes, I know...), and after the line (defun unstable ( ....... )) you want to ask the user for the title? Perhaps as the 2ns or 3rd line of code, something like that.

(setq TableTitle (getstring "Enter Table Title" T))

should do the trick. The T at the end allows the user to enter spaces (usually pressing 'space' acts the same as enter, T prevents this. Also add your variable name in the (defun line to localise it (so that it's value doesn't 'leak' into other LISPs if they use the same variable name:

(defun UnsTable ( refs / ss name ref insPt table row acounter MyColumns TableTitle)

Next pop this variable into the table. In your LISP you will have a line I'd search for "DRILLING" to get to it quickly. Probably very similar to the example above where I used "HOLES"

(vla-setText table 0 0 "Holes") ; table title ; set in column 0, row 0 (LISP count from as the first number)

replace the test string here with the variable you got earlier. Remember that the text string will have " " either side, a variable wont:

(vla-setText table 0 0 TableTitle) ; table title ; set in column 0, row 0 (LISP count from as the first number)

That should do it

July 11, 2023

Magic, I'm starting to understand it a bit more - thanks again Steven!!

Sign In

Table lisp file

Recommended Posts

ASH71

Steven P

ASH71

Steven P

ASH71

Steven P

Steven P

BIGAL

ASH71

ASH71

Steven P

ASH71

Steven P

BIGAL

ASH71

Steven P

ASH71

Join the conversation

Tutorials

Forums

Activity