Jump to content
Loidy

Total Volume by Layers and Displayed in Table (Request)

Recommended Posts

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

Share this post


Link to post
Share on other sites
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

 

Share this post


Link to post
Share on other sites
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. >..<

Share this post


Link to post
Share on other sites
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))))))

 

Share this post


Link to post
Share on other sites
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))
    )
  )

 

 

Share this post


Link to post
Share on other sites
BIGAL

Look in the boxes 

 

OLD CODE

NEW CODE

Share this post


Link to post
Share on other sites

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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

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