Issue with Lisp to record values without tolerances in a table, Autocad LT

[torpass]

Hi everyone,

I’m working with a Lisp file that I need to use in AutoCAD LT, which, as we know, has limited support for Lisp routines. The Lisp creates a table with the dimensions of multiple rectangles. Currently, it records the dimension values but includes tolerances (decimals). I need the values to be recorded without tolerances (whole numbers), even when the values have decimals. I'll post this image to highlight those errors that should not occur:

It also doesn't count always all the rectangles, and I don't know why.
This LISP has to be reliable. 

Since this Lisp needs to function in AutoCAD LT, I’m looking for help in making the necessary adjustments so that the table records the rectangles dimensions without decimals. Any guidance on how to achieve this within LT's limitations would be greatly appreciated!

Thank you in advance!

(defun rectangle_dims (e / l a b)
  (setq l (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) e)))
  (if
    (and
      (or
        (= 1 (logand (cdr (assoc 70 e)) 1))
        (equal (car l) (last l) 1e-8)
      )
      (equal (distance  (car   l) (caddr l)) (distance  (cadr   l) (cadddr l)) 1e-8)
      (equal (mapcar '- (cadr  l) (car   l)) (mapcar '- (caddr  l) (cadddr l)) 1e-8)
      (equal (mapcar '- (caddr l) (cadr  l)) (mapcar '- (cadddr l) (car    l)) 1e-8)
    )
    (vl-sort (list (fix (distance (car l) (cadr l))) (fix (distance (cadr l) (caddr l)))) '<)
  )
)

(defun C:TAB (/ *error* ss e old r p1 c)
  (vl-load-com)
  (setq acObj (vlax-get-acad-object)
        acDoc (vla-get-activedocument acObj)
        space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
  )
  (vla-startundomark acDoc)
  
  ;;;;;; Error function ;;;;;;;;;
  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nError: " msg))
      )
    (vla-endundomark acDoc)
    (princ)
    )
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (if
    (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (90 . 4) (90 . 5) (-4 . "OR>"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              c (cond
                  ((cdr (assoc 62 (entget e))))
                  ((cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 (entget e)))))))
                )
              c (if (zerop c) 7 c)
              )
        (if
          (and
            (setq dims (rectangle_dims (entget e)))
            (setq dims (cons c dims))
            )
          (if
            (setq old (vl-some '(lambda (d) (if (equal (cdr d) dims 1e-8) d)) r))
            (setq r (subst (cons (1+ (car old)) dims) old r))
            (setq r (cons  (cons 1 dims) r))
          )
        )
      )
      (if
        (and r (setq p1 (getpoint "\nSpecify table insert point: ")))
        (insert_table
          (vl-sort
            (vl-sort
              (vl-sort
                (mapcar '(lambda (a) (list (fix (cadr a)) (fix (caddr a)) (fix (cadddr a)) (car a))) r)
                 '(lambda (a b) (< (cadr a) (cadr b)))
                )
               '(lambda (a b) (< (car a) (car b)))
             )
            '(lambda (a b) (> (caddr a) (caddr b)))
          )
          p1
          )       
         )
       )
    )
  (princ)
)

;;The textheight in table depends on cannonscale
(defun insert_table (lst pct / tab row col ht i n acol)
  (setq ht  (/ 2.5 (getvar 'cannoscalevalue))
        pct (trans pct 1 0)
        n   (trans '(1 0 0) 1 0 T)
        tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 3 (length lst)) 3 (* 1.5 ht) ht))
        acol (vla-getcellcontentcolor tab 0 0)
        )
  (vlax-put tab 'direction n)
  (vla-mergecells tab 1 1 0 2)
  (mapcar
    (function
      (lambda (rowType)
        (vla-SetTextStyle  tab rowType (getvar 'textstyle))
        (vla-SetTextHeight tab rowType ht)
      )
    )
   '(2 4 1)
  )
  (vla-put-HorzCellMargin tab (* 0.14 ht))
  (vla-put-VertCellMargin tab (* 0.14 ht))
  (setq lst (cons '(nil "sec" "Lenght" "pcs") lst))
  (setq lst (mapcar '(lambda (el) (list (car el) (last el) (cadr el) (caddr el))) lst)) 
  (setq lst (cons '(nil "sp:" nil nil) lst))
  (setq i 0)
  (foreach col (apply 'mapcar (cons 'list (mapcar 'cdr lst)))
    (vla-SetColumnWidth tab i
      (apply
        'max
        (mapcar
          '(lambda (x)
             ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
              (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))
              )
             )
          col
          )
        )
      )
    (setq i (1+ i))
    )
  (setq lst (cons '(nil "Title") lst))
  (setq row 0)
  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c (cdr r)
      (vla-SetText tab row col (vl-princ-to-string c))
      (if
        (car r)
        (progn
          (if (/= (vla-get-colorindex acol) (car r)) (vla-put-colorindex acol (car r)))
          (vla-SetCellContentColor tab row col acol)
          )
        )
      (setq col (1+ col))
      )
    (setq row (1+ row))
    )
  )
  
(princ "\nType TAB to start the command")

[komondormrex]

hey there,

check the mod to your original lisp code i've made recently just for this case. can't test it on your file thou. hth.

;***********************************************************************************************************************************

(defun round_up (in_number)
	(if (>= (- in_number (fix in_number)) 0.5) (1+ (fix in_number)) (fix in_number))
)

;***********************************************************************************************************************************

(defun rectangle_dims_color (e / v b)
  	(setq v (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e)))
		  b (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) (entget e)))
	)
  	(if
  	  	(and
  	  	  	(or
  	  	  	  (= 1 (logand (cdr (assoc 70 (entget e))) 1))
  	  	  	  (equal (car v) (last v) 1e-8)
  	  	  	)
  	  	  	(equal (distance  (car   v) (caddr v)) (distance  (cadr   v) (cadddr v)) 1e-8)
  	  	  	(equal (mapcar '- (cadr  v) (car   v)) (mapcar '- (caddr  v) (cadddr v)) 1e-8)
  	  	  	(equal (mapcar '- (caddr v) (cadr  v)) (mapcar '- (cadddr v) (car    v)) 1e-8)
			(zerop (apply '+ (mapcar 'abs b)))
  	  	)
  	  	(append (mapcar 'round_up (vl-sort (list (distance (car v) (cadr v)) (distance (cadr v) (caddr v))) '<))
				(list (get_color e))
		)
  	)
	;		((section length color) pcs)
)

;***********************************************************************************************************************************

(defun get_color (ename / color)
	(setq color (cdr (assoc 62 (entget ename))))
	(cond
		((null color) (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 (entget ename)))))))
		((= 0 color) 7)
		(color)
	)
)

;***********************************************************************************************************************************

(defun get_value_width (value cell_text_height)
	(setq text_box (textbox (list (cons 1 (vl-princ-to-string value))
								  (cons 7 (getvar 'textstyle)) (cons 40 cell_text_height)
							)
				   )
	)
	(+ (abs (- (caadr text_box) (caar text_box))) (* 2.0 cell_text_height))
)

;***********************************************************************************************************************************

;;The textheight in table depends on cannonscale
(defun insert_table (row_list point / cell_text_height point n header table color_object row_list row_index column_index)
  	(setq cell_text_height (/ 2.5 (getvar 'cannoscalevalue))
  	      point (trans point 1 0)
  	      n (trans '(1 0 0) 1 0 T)
		  title "XX"
		  sub_title "sp:"
		  header '("PCS" "SECTION" "LENGTH")
  	      table (vla-addtable (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
		  					  (vlax-3d-point point)
							  (+ 3 (length row_list))
							  (length header)
							  (* 1.5 cell_text_height)
							  cell_text_height
				)
;  	      color_object (vlax-create-object (strcat "AutoCAD.AcCmColor." (substr (getvar 'acadver) 1 2)))
  	      color_object (vla-getcellcontentcolor table 0 0)
  	)
  	(vlax-put table 'direction n)
  	(vla-mergecells table 1 1 0 (1- (length header)))
  	(mapcar '(lambda (rowType) (vla-SetTextStyle  table rowType (getvar 'textstyle))
  	      					   (vla-SetTextHeight table rowType cell_text_height)
  	    	 )
  	 		'(1 2 3 4)
  	)
	(setq row_list (mapcar '(lambda (row) (list (last row) (car (car row)) (cadr (car row)) (caddr (car row)))) row_list))
  	(vla-put-HorzCellMargin table (* 0.14 cell_text_height))
  	(vla-put-VertCellMargin table (* 0.14 cell_text_height))
  	(setq row_list (append (list header) row_list))
  	(mapcar '(lambda (width header_item) (vla-SetColumnWidth table (vl-position header_item header) width))
			(mapcar '(lambda (width_list) (apply 'max width_list))
							 (mapcar '(lambda (column) (mapcar '(lambda (cell_value) (get_value_width cell_value cell_text_height))
							 									column
													   )
									  )
									  (apply 'mapcar (cons 'list row_list))
							 )
			)
			header
	)
  	(setq row_list (append (list (list title) (list sub_title)) row_list))
  	(setq row_index 0)
  	(foreach row row_list
  	  (setq column_index 0)
  	  (vla-SetRowHeight table row_index (* 1.5 cell_text_height))
	  (repeat (length header)
  	  	(if (nth column_index row) (vla-SetText table row_index column_index (vl-princ-to-string (nth column_index row))))
		(if (nth (length header) row)
			(progn
	  			(vla-put-colorindex color_object (nth (length header) row))
  	  			(vla-SetCellContentColor table row_index column_index color_object)
			)
	  	)
  	  	(vla-SetCellalignment table row_index column_index acMiddleCenter)
		(setq column_index (1+ column_index))
	  )
  	  (setq row_index (1+ row_index))
	)
 )

;***********************************************************************************************************************************

(defun c:rect_tab (/ rect_sset sec_len_color rect rects)
  	(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  	(if (setq rect_sset (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (90 . 4) (90 . 5) (-4 . "OR>"))))
		(progn
			(foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex rect_sset)))
				(if (setq sec_len_color (rectangle_dims_color ename))
						(if (setq rect (assoc sec_len_color rects))
							(setq rects (subst (list (car rect) (1+ (last rect))) rect rects))
							(setq rects (append rects (list (list sec_len_color 1))))
						)
				)
			)
  			(if (and rects
					(setq table_point (getpoint "\nSpecify table insert point: "))
				)
  			  	(insert_table
					(vl-sort (vl-sort (vl-sort rects
							   			 	 '(lambda (rect_1 rect_2) (< (caar rect_1) (caar rect_2)))
								 	  )
									 '(lambda (rect_1 rect_2) (< (cadr rect_1) (cadr rect_2)))
							 )
						    '(lambda (rect_1 rect_2) (< (cadar rect_1) (cadar rect_2)))
					)
  			  	  	table_point
  			  	)
  			)
		)
	)
  	(princ)
)

;***********************************************************************************************************************************