Total Volume by Layers and Displayed in Table (Request)

[Loidy]

Good Day, first of all I do not own these files, credits to them (forgot where did I get it)

Anyway, I'd like to request a LISP that could compute the TOTAL VOLUME/MASS of SELECTED OBJECTS only, and displayed the result in table just like LAYLENGTH table format. 

For Example..

 

LAYER NAME          |            VOLUME           

Layer1                       |            20              (in cubic meters)         

Layer2                        |            35              (in cubic meters)                   

Layer3                        |            9.09          (in cubic meters)                  

 

my drawing units are mostly in  9,091,687,322.3094 (millimeters) but I need it in 9.09 (cubic meters) if possible,

and the table in LAYLENGTH is too small, can it also scale to the size of table in drawing file.

Thanks

3DVOL2.lsp LAYLENGTH.txt Drawing1.dwg

[BIGAL]

1st you need to change the ssget for volumes to include the layer filter.

 

(if (and (setq ss (ssget '((0 . "3DSOLID"))))


(setq lay (cdr (assoc 8 (entget (car (entsel "\nSelect object for layer"))))))
(if (and (setq ss (ssget (list '(0 . "3DSOLID")(cons 8 lay))))

MM to m vol 

(setq vol  (* vol 1e-06)) 

 (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))

 

ht  (/ 2.5 (cond ((getvar 'cannoscalevalue)) (1.0)))

ht 25 ; some ht value that you want

 

[Loidy]

@BIGAL thanks sir, however I don't know where should I put that codes or which codes to change. I'm totally no idea about lisp. >..<

[BIGAL]

I posted the changes above find the matching lines and replace.

 

(setq vol (+ (cond
                          (vol)
                          ((setq vol 0)))
                        (vla-get-volume 3dObj)))))
						
(setq vol ( * 1e-06 (+ (cond
                          (vol)
                          ((setq vol 0)))
                        (vla-get-volume 3dObj))))))

 

[Loidy]

@BIGAL sorry sir, but I still don't know what are lines to change in codes. I'm totally no idea.

 

 

(defun C:LAYLENGTH ( / *error* acdoc ss p i e a d l) (vl-load-com)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark acdoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (if
      (= 8 (logand (getvar 'undoctl) 8))
      (vla-endundomark acdoc)
    )
    (princ)
    )
  
  (if
    (and
      (setq ss (ssget ":L" '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
      (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
      )
    (progn
      (repeat
        (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              a (cdr (assoc 8 (entget e)))
              d (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
        )
        (if
          (setq o (assoc a l))
          (setq l (subst (list a (+ (cadr o) d)) o l))
          (setq l (cons (list a d) l))
        )
      )
      (setq l (vl-sort l '(lambda (a b) (< (car a) (car b)))))
      (insert_table l p)
      )
    )
  (*error* nil)
  (princ)
  )

(defun insert_table (lst pct / tab row col ht i n space)
  (setq space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
        ht  (/ 2.5 (cond ((getvar 'cannoscalevalue)) (1.0)))
        pct (trans pct 1 0)
        n   (trans '(1 0 0) 1 0 T)
        tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 2 (length lst)) (length (car lst)) (* 2.5 ht) ht))
        )
  (vlax-put tab 'direction n)
  
  (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 (mapcar '(lambda (a) (strcat "Col" (itoa (1+ (vl-position a (car lst)))))) (car lst)) lst))

  (setq i 0)
  (foreach col (apply 'mapcar (cons 'list 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 '("TITLE") lst))
  
  (setq row 0)
  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c r
      (vla-SetText tab row col (if (numberp c) (rtos c) (vl-princ-to-string c)))
      (setq col (1+ col))
      )
    (setq row (1+ row))
    )
  )

 

 

[BIGAL]

Look in the boxes 

 

OLD CODE

NEW CODE