Jump to content

Recommended Posts

Posted (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 by aridzv
Posted

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.

 

 

 

Posted (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 by aridzv
Posted

 

 

 

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))

 

🐉

  • Thanks 1
Posted

@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

Posted

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.

 

Posted

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.

Posted (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 by aridzv
Posted

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)
)

 

  • Thanks 1
Posted

@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.

Posted

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_) 
)

 

  • Like 1
  • 11 months later...
Posted (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 by aridzv
Posted

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.

  • Thanks 1
Posted (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 by aridzv

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...