Message 1 of 3
Dynamic Table: Adjusting tolerance, Sorting by Descending Order
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello everyone,
I need assistance with modifying this LISP. The current version of the script calculates dimensions and inserts tables in AutoCAD based on certain rectangle parameters. However, I need to make the following adjustments:
Increase Precision: I would like to reduce the tolerance in the calculations by adding one-tenth of a millimeter (0.1 mm). This should be applied to all relevant measurements and comparisons, so the tolerance is more precise when printed on the table.
Sort Values by Length in Descending Order: Currently, the script sorts the data in a way that doesn't prioritize in descending order. I'd like to change the order of the values so that the section, and then the lengths, are arranged from largest to smallest.
Would you be able to help modify the script to incorporate these changes?
Thank you in advance!
dwg example below
;***********************************************************************************************************************************
(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 "E"
sub_title "sp:"
header '("Pcs" "Section" "Lenght")
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: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)
)
;***********************************************************************************************************************************
