aridzv Posted September 4, 2022 Share Posted September 4, 2022 (edited) Hi. I searched this topic and found some lisp's (Lee Mac had a couple), But none of them really met my needs (always close but not quite). Now, what I'm trying to do is select a group of blocks and insert the data into table with 3 columns that represent 3 attributes and sort the table from the smallest to the largest according to the first column (see attached DWG file): 1. ORDER (sort the table by this value from smallest to lagrest), and if possible to change the column header to "ITEM No." instead of "ORDER" which is the attribute name. 2. ITEM DESCRIPTION 3. total quantity (THIS COLUMN IS OPTIONAL - IF IT IS TOO COMPLICATED THEN IT CAN BE OMITTED) Any help would be appreciated, many thanks - aridzv. *at the moment I'm using dataextraction,export the data to excel,arrange it and import it back to cad using datalinked table. EXPORT2TABLE.dwg Edited September 4, 2022 by aridzv Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 5, 2022 Share Posted September 5, 2022 Ok a couple of suggestions needs a custom quantity count rather than a simple count blocks, the Item 1 are dynamic blocks so they should be counted based on their length and effective name, same with 4. I have something as an example it counts, dynamic blocks using a property, normal blocks based on attributes, multi line by length, plines by area. Then makes a table of the answers. It is in a sorted order as that is used in the counting up to 5 levels deep. I will add to my to do list as it will need to look for certain items Insert, Lines etc in your dwg. Quote Link to comment Share on other sites More sharing options...
aridzv Posted September 5, 2022 Author Share Posted September 5, 2022 (edited) @BIGAL thanks for the reply! As I guessed, the issue of custom quantity count complicates things and I can do without it,so at this point I think it's best to ignore it. if you could help me with a table of the first 2 columns including removing duplicates - that will be a great help for me. the 2 columns I need are: 1. "ORDER" attribute column and sort the table from smallest to largest by this column. 2. "ITEM DESCRIPTION" attribute column. thanks, aridzv Edited September 5, 2022 by aridzv Quote Link to comment Share on other sites More sharing options...
rlx Posted September 5, 2022 Share Posted September 5, 2022 Hi AridZV, havent done much lisping anymore so just to get you started. I leave the table creating to you or somebody else because this has been done a google times on this forum (defun c:aridzv ( / ss l sl) (princ "\nSelect blocks : ") (cond ((not (setq ss (ssget '((0 . "INSERT"))))) (princ "\nComputer says no : nothing selected")) ((not (vl-consp (setq l (process_blocks ss)))) (princ "\nComputers says no : sorry no can do")) (t (setq l (sort_list l)) (create_table l)) ) (princ) ) (defun process_blocks ( %ss / lst order descr ) (foreach bo (SS->OL %ss) (setq order (sav bo "ORDER") descr (sav bo "ITEM_DESCRIPTION")) (if (and order descr) (setq lst (update_list order descr lst))) (setq order nil descr nil) ) lst ) ; description plus example : (update_list order description list) ; (setq lst (list (cons "1" (list "a" 1)) (cons "3" (list "c" 1)))) ; - update counter for order 1 from 1 -> 2 ; (setq lst (update_list "1" "a" lst)) -> (("1" "a" 2) ("3" "c" 1)) ; - add order "2" ; (setq lst (update_list "2" "b" lst)) -> (("1" "a" 2) ("3" "c" 1) ("2" "b" 1)) ; now sort the list ; (sort_list lst) -> (("1" "a" 2) ("2" "b" 1) ("3" "c" 1)) (defun update_list ( o d l / r) (if (not (setq r (assoc o l))) (setq l (append l (list (cons o (list d 1))))) (setq l (subst (cons o (list (cadr r) (1+ (caddr r)))) r l)) ) ) (defun sort_list (l) (vl-sort l (function (lambda (a b) (< (atoi (car a)) (atoi (car b))))))) ; at this point your list is sorted & ready to go (defun create_table (l) (princ "\n\n*** Ask Google how to create a table ***\n\n") (prl l) (textscr) ) ; tiny lisp lib ; show attribute value (defun sav ( blk tag ) (setq tag (strcase tag) blk (ent->vla blk)) (if blk (vl-some '(lambda (x) (if (= tag (strcase (vla-get-tagstring x))) (vla-get-textstring x))) (vlax-invoke blk 'getattributes)))) (defun ent->vla ( e / ss ) (cond ((= (type e) 'VLA-OBJECT) e) ((= (type e) 'ENAME)(vlax-ename->vla-object e)) ((and (= (type e) 'STR) (tblsearch "block" e)(setq ss (ssget "x" (list (cons 0 "INSERT")(cons 2 e))))) (ent->vla (ssname ss 0))) (t nil) ) ) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun prl (lst)(mapcar '(lambda(x)(princ "\n")(princ x)) lst)) 1 Quote Link to comment Share on other sites More sharing options...
aridzv Posted September 5, 2022 Author Share Posted September 5, 2022 @rlx Thanks! First - thank you for the descriptions,it is highly helpful!! If I understand you correctly- the list l is tow dimensional list (n/n i.e. tow columns) and I should look for the way to crate a table from it? aridzv Quote Link to comment Share on other sites More sharing options...
rlx Posted September 5, 2022 Share Posted September 5, 2022 by the time you enter the function (create_table l) list l is sorted and has the format : [0] ("1" "PVC PIPE DN110 PN10 ID-101.6 GRAY" 5) [1] ("2" "PVC REDUCING BUSHING 160x110 SW" 3) [2] ("3" "PVC SOCKET 160 SW" 1) [3] ("4" "PVC PIPE DN160 PN10 ID-147.6 GRAY" 1) [4] ("5" "PE SADDLE SINGLE OUTLET WITH REINFORCING RING 160 - 1\"" 1) [5] ("6" "AIR VALVE BERMAD C10 1\" BSPT PN-10" 1) [6] ("7" "PVC TEE 160 SW" 1) [7] ("8" "PVC ELBOW 90° 110SW" 2) [8] ("9" "PVC TEE 110 SW" 2) [9] ("10" "PVC REDUCING BUSHING 110x90 SW" 1) so each row has 3 elements : order , description & quantity all you need now is to feed this list to a table. Quote Link to comment Share on other sites More sharing options...
rlx Posted September 5, 2022 Share Posted September 5, 2022 for a table example have a look at this post : Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 5, 2022 Share Posted September 5, 2022 My take on make a table. ; example of creating a table using passed variables ; By Alan H July 2017 (defun AH:table_make (numcolumns numrows txtsz colwidth / numrows curspc colwidth numcolumns numrows objtable rowheight sp doc) (vl-load-com) (setq sp (vlax-3d-point (getpoint "Pick top left"))); or use getpoint (setq doc (vla-get-activedocument (vlax-get-acad-object) )) (if (= (vla-get-activespace doc) 0) (setq curspc (vla-get-paperspace doc)) (setq curspc (vla-get-modelspace doc)) ) (setq rowheight (* 2.0 txtsz)) (setq objtable (vla-addtable curspc sp numrows numcolumns rowheight colwidth)) (vla-settext objtable 0 0 "TABLE title") (vla-SetTextHeight Objtable (+ acDataRow acTitleRow acHeaderRow) txtsz) (setq i -1) (setq a 64) (repeat numcolumns (vla-setcolumnwidth objtable (setq i (+ i 1)) colwidth) (vla-SetText Objtable 1 i (chr (setq a (+ a 1)))) ) (vla-SetText Objtable 1 i "Count") ; (command "_zoom" "e") (princ) ) I had a look at your dwg and just trying to understand your dynamic block so can get the "d1" variable to include in quantities. Quote Link to comment Share on other sites More sharing options...
aridzv Posted September 8, 2022 Author Share Posted September 8, 2022 (edited) @rlx @BIGAL Hi, thank you both for your answers and sorry for the late response. unfortunately My coding skills are nowhere near the level needed to directly use the examples you provided. Regarding @BIGAL example - it is a little unclear for me what variable contains the list that hold the table data, And I saw that it was necessary to transfer the number of rows and columns. so, should I calculate them in the main function and pass them as variables to the table creation function? @BIGAL: about the "d1" variable - it is a parametric block and not a dynamic one (bricscad...). let me start from the end - d1 dosn't need to be included in the table. and here is why: this parametric block represent a lateral element,a pipe for that matter. d1 sets the pipe object length, and I use lisp to handle it (lisp that people here in this forum helped me writing - I'm not skilled enough to write this kind of lisp without help). now,in that lisp after the length is set, this value is in drawing units,and in that lisp at the beginning the user is promt to specify by what number to divide the length: 1000 if the drawing units is mm or 1 if the drawing units are m, and according to that the value of d1 (only the value!! d1itself remain untouched) is divided by this factor and the resault is stored in "QUANTITY" field as the pipe length (m). thanks, aridzv. Edited September 8, 2022 by aridzv Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 10, 2022 Share Posted September 10, 2022 Give you a try and let me know. (defun c:Test (/ lst int sel ent ord qty itm get tag str ins tbl row col) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (princ "\nSelect attributed blocks : ") (setq int -1 sel (ssget '((0 . "INSERT") (66 . 1)))) (while (setq int (1+ int) ent (ssname sel int)) (setq ord nil qty nil itm nil) (while (/= (cdr (assoc 0 (setq get (entget (setq ent (entnext ent)))))) "SEQEND") (setq tag (cdr (assoc 2 get)) str (cdr (assoc 1 get)) ) (vl-some (function (lambda (j k) (and (= tag j) (set k str)))) '("ORDER" "QUANTITY" "ITEM_DESCRIPTION") '(ord qty itm) ) ) (and ord itm qty (or (vl-some '(lambda (u) (and (eq (car u) ord) (eq (cadr u) itm) (setq lst (subst (list ord itm (vl-princ-to-string (+ (read qty) (read (caddr u))) ) ) u lst ) ) ) ) lst ) (setq lst (cons (list ord itm qty) lst)) ) ) lst ) (setq ins (getpoint "\nSpecify table insertion point : ")) (setq tbl (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-3d-point ins) (1+ (length lst)) 3 145 46 ) row 2 col -1 ) (progn (mapcar '(lambda (w) (vla-setcolumnwidth tbl (setq col (1+ col)) w)) '(145 845 88) ) (setq col -1) (vla-put-RegenerateTableSuppressed tbl :vlax-true) (vla-put-Vertcellmargin tbl 10.55) (vla-put-Horzcellmargin tbl 10.55) (vla-unmergecells tbl 0 0 0 2) (mapcar '(lambda (s c) (Set:text:contents_ tbl 0 c s) (vla-setrowheight tbl 0 45) ) '("ITEM No." "ITEM DESCRIPTION" "QTY") '(0 1 2) ) (setq row 1 col -1 ) (foreach itm (vl-sort lst (function (lambda (j k) (< (atoi (car j)) (atoi (car k)))) ) ) (mapcar '(lambda (s c) (Set:text:contents_ tbl row c s) ) itm '(0 1 2) ) (vla-setrowheight tbl row 1.0) (setq row (1+ row) col -1 ) ) (vla-put-RegenerateTableSuppressed tbl :vlax-false) ) ) (princ) ) (vl-load-com) (defun Set:text:contents_ (o_ r_ c_ v_) (vla-settext o_ r_ c_ (strcat "{\\fCalibri|b0|i0|c0|p34;" v_ "}")) (vla-setcelltextheight o_ r_ c_ 18.5) (vla-setcellalignment o_ r_ c_ acMiddleLeft) ) 1 Quote Link to comment Share on other sites More sharing options...
aridzv Posted September 10, 2022 Author Share Posted September 10, 2022 @Tharwat IT'S PERFECT - THANKS!!! one small quastion - in your code i've tried to change the aligment of the first column (ITEM No.) to middle-center like this but it failed: (vla-setcellalignment o_ acMiddleCenter) is there a way to make the first and last column aligment middle-center and keep the middle column (quantity column) Middle-Left? It's not a big deal, so if it's too much trouble don't bother about it. and again - many thanks!! aridzv. Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 10, 2022 Share Posted September 10, 2022 Glad that you got it working as expected. Here is another to adjust the alignment as you requested. (defun c:Test (/ lst int sel ent ord qty itm get tag str ins tbl row col) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (princ "\nSelect attributed blocks : ") (setq int -1 sel (ssget '((0 . "INSERT") (66 . 1)))) (while (setq int (1+ int) ent (ssname sel int)) (setq ord nil qty nil itm nil) (while (/= (cdr (assoc 0 (setq get (entget (setq ent (entnext ent)))))) "SEQEND" ) (setq tag (cdr (assoc 2 get)) str (cdr (assoc 1 get)) ) (vl-some (function (lambda (j k) (and (= tag j) (set k str)))) '("ORDER" "QUANTITY" "ITEM_DESCRIPTION") '(ord qty itm) ) ) (and ord itm qty (or (vl-some '(lambda (u) (and (eq (car u) ord) (eq (cadr u) itm) (setq lst (subst (list ord itm (vl-princ-to-string (+ (read qty) (read (caddr u))) ) ) u lst ) ) ) ) lst ) (setq lst (cons (list ord itm qty) lst)) ) ) lst ) (setq ins (getpoint "\nSpecify table insertion point : ")) (setq tbl (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-3d-point ins) (1+ (length lst)) 3 145 46 ) row 2 col -1 ) (progn (mapcar '(lambda (w) (vla-setcolumnwidth tbl (setq col (1+ col)) w)) '(145 845 88) ) (setq col -1) (vla-put-RegenerateTableSuppressed tbl :vlax-true) (vla-put-Vertcellmargin tbl 10.55) (vla-put-Horzcellmargin tbl 10.55) (vla-unmergecells tbl 0 0 0 2) (mapcar '(lambda (s c) (Set:text:contents_ tbl 0 c s acMiddleLeft) (vla-setrowheight tbl 0 45) ) '("ITEM No." "ITEM DESCRIPTION" "QTY") '(0 1 2) ) (setq row 1 col -1 ) (foreach itm (vl-sort lst (function (lambda (j k) (< (atoi (car j)) (atoi (car k)))) ) ) (mapcar '(lambda (s c a) (Set:text:contents_ tbl row c s (eval a)) ) itm '(0 1 2) '(acMiddleCenter acMiddleLeft acMiddleCenter) ) (vla-setrowheight tbl row 1.0) (setq row (1+ row) col -1 ) ) (vla-put-RegenerateTableSuppressed tbl :vlax-false) ) ) (princ) ) (vl-load-com) (defun Set:text:contents_ (o_ r_ c_ v_ a_) (vla-settext o_ r_ c_ (strcat "{\\fCalibri|b0|i0|c0|p34;" v_ "}")) (vla-setcelltextheight o_ r_ c_ 18.5) (vla-setcellalignment o_ r_ c_ a_) ) 1 Quote Link to comment Share on other sites More sharing options...
aridzv Posted September 10, 2022 Author Share Posted September 10, 2022 @Tharwat PERFECT!!!! many thanks, aridzv. 1 Quote Link to comment Share on other sites More sharing options...
aridzv Posted August 21, 2023 Author Share Posted August 21, 2023 (edited) Hi. I'm trying to chane the order of the columns but failed... the order now is ("ITEM No." "ITEM DESCRIPTION" "QTY"). I need to change it to ("QTY" "ITEM DESCRIPTION" "ITEM No.") thanks, aridzv *EDIT: I uplloaded the sample file and the final lisp agin here. EXPORT2TABLE.dwg Assembly_Table.lsp Edited August 21, 2023 by aridzv Quote Link to comment Share on other sites More sharing options...
BIGAL Posted August 22, 2023 Share Posted August 22, 2023 Change this line (setq lst (cons (list ord itm qty) lst)) in terms of the item order. This will fix the data cells, you need to also do the headings. '("ORDER" "QUANTITY" "ITEM_DESCRIPTION") '(ord qty itm) Hopefully works not tested. 1 Quote Link to comment Share on other sites More sharing options...
aridzv Posted August 22, 2023 Author Share Posted August 22, 2023 (edited) Hi. I'm trying to add another column name "UNIT" to the table. UNIT attribute exists of course in the blocks. EDIT: look like I managed to get the code working. I would appreciate it if someone could look at the code, and make comments if necessary. (defun c:Assembly_TableH1 (/ lst int sel ent ord qty itm un get tag str ins tbl row col) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (princ "\nSelect attributed blocks : ") (setq int -1 sel (ssget '((0 . "INSERT") (66 . 1)))) (while (setq int (1+ int) ent (ssname sel int)) (setq ord nil qty nil itm nil un nil) (while (/= (cdr (assoc 0 (setq get (entget (setq ent (entnext ent)))))) "SEQEND" ) (setq tag (cdr (assoc 2 get)) str (cdr (assoc 1 get)) ) (vl-some (function (lambda (j k) (and (= tag j) (set k str)))) '("ORDER" "QUANTITY" "ITEMDESCRIPTIONHEB" "UNIT") '(ord qty itm un) ) ) (and ord itm qty un (or (vl-some '(lambda (u) (and (eq (car u) ord) (eq (cadr u) itm) (eq (cadddr u) un) (setq lst (subst (list ord itm (vl-princ-to-string (+ (read qty) (read (caddr u))) ) un ) u lst ) ) ) ) lst ) (setq lst (cons (list ord itm qty un) lst)) ) ) lst ) (setq ins (getpoint "\nSpecify table insertion point : ")) (setq tbl (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-3d-point ins) (1+ (length lst)) 4 145 46 ) row 2 col -1 ) (progn (mapcar '(lambda (w) (vla-setcolumnwidth tbl (setq col (1+ col)) w)) '(145 120 845 120) ) (setq col -1) (vla-put-RegenerateTableSuppressed tbl :vlax-true) (vla-put-Vertcellmargin tbl 10.55) (vla-put-Horzcellmargin tbl 10.55) (vla-unmergecells tbl 0 0 0 2) (mapcar '(lambda (s c) (Set:text:contents_ tbl 0 c s acMiddlecenter) (vla-setrowheight tbl 0 45) ) '("ITEM No." "ITEM DESCRIPTION" "QTY" "UNIT") '(3 2 1 0) ) (setq row 1 col -1 ) (foreach itm (vl-sort lst (function (lambda (j k) (< (atoi (car j)) (atoi (car k)))) ) ) (mapcar '(lambda (s c a) (Set:text:contents_ tbl row c s (eval a)) ) itm '(3 2 1 0) '(acMiddlecenter acMiddleRight acMiddlecenter acMiddlecenter) ) (vla-setrowheight tbl row 1.0) (setq row (1+ row) col -1 ) ) (vla-put-RegenerateTableSuppressed tbl :vlax-false) ) ) (princ) ) (vl-load-com) (defun Set:text:contents_ (o_ r_ c_ v_ a_) (vla-settext o_ r_ c_ (strcat "{\\fcalibri|b0|i0|c0|p34;" v_ "}")) (vla-setcelltextheight o_ r_ c_ 18.5) (vla-setcellalignment o_ r_ c_ a_) ) thanks, aridzv Edited August 22, 2023 by aridzv Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.