### Author Topic: Help: Calculate volume from contours  (Read 1602 times)

0 Members and 1 Guest are viewing this topic.

#### mhy3sx

• Newt
• Posts: 120
##### Help: Calculate volume from contours
« on: June 13, 2023, 09:21:36 AM »
Hi, I am using this code to calculate the volume from contours.
I want to do 2 updates to this code

1) This code is not calculate correct in 2 decimals the volume. Perhaps use the contour areas with more decimals.
2) I want the results to be in table like the attach file

Code - Auto/Visual Lisp: [Select]
1. (defun c:test   (/ _foo _rtos a b r s v)
2.   ;; RJP » 2021-09-17
3.   (defun _foo (e) (list (vlax-curve-getarea e) (cdr (assoc 38 (entget e)))))
4.   (defun _rtos (n) (rtos n 2 2))
5.   (cond ((and (setq s (ssget '((0 . "*polyline") (-4 . "&=") (70 . 1))))
6.               (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
7.          )
8.          (setq s (mapcar '_foo s))
9.          (setq s (vl-sort s '(lambda (r j) (> (car r) (car j)))))
11.            (setq a (car s)
13.                  s (cdr s)
14.            )
15.            ;; Average of areas multiplied by height = volume
16.            (setq v
17.                   (* (/ (apply '+ (mapcar 'car (list a b))) 2) (abs (apply '- (mapcar 'cadr (list a b)))))
18.            )
19.
20.            (princ (strcat "\n("
22.                           " - "
24.                           ") = "
25.                           (_rtos v) " m3"
26.                   )
27.            )
28.            (setq r (cons v r))
29.          )
30.          (princ (strcat "\nV = " (_rtos (apply '+ r))" m3"))
31.          (textscr)
32.         )
33.   )
34.   (princ)
35. )
36.
37.

Thanks

#### mhy3sx

• Newt
• Posts: 120
##### Re: Help: Calculate volume from contours
« Reply #1 on: June 13, 2023, 01:14:28 PM »
How to round to 2 decimal this

Code - Auto/Visual Lisp: [Select]
1.   (defun _foo (e) (list (vlax-curve-getarea e) (cdr (assoc 38 (entget e))))
2.

I try this but is not working

Code - Auto/Visual Lisp: [Select]
1.   (defun _foo (e) (list (rtos (vlax-curve-getarea e) (cdr (assoc 38 (entget e)))2 2)))
2.

Thanks

#### ronjonp

• Needs a day job
• Posts: 7528
##### Re: Help: Calculate volume from contours
« Reply #2 on: June 13, 2023, 02:30:29 PM »
Change the _RTOS function to a larger or smaller number to see more or less decimal places:
Code - Auto/Visual Lisp: [Select]
1. (defun _rtos (n) (rtos n 2 0-15))

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

#### mhy3sx

• Newt
• Posts: 120
##### Re: Help: Calculate volume from contours
« Reply #3 on: June 13, 2023, 06:35:47 PM »
Hi ronjonp. If you see in the first post I already have

Code: [Select]
`  (defun _rtos (n) (rtos n 2 2)) ; for 2 decimals`

But if you see the test.dwg file the volumes are not correct, because in this line

Code: [Select]
`  (defun _foo (e) (list (vlax-curve-getarea e) (cdr (assoc 38 (entget e))))`
the area is calculated from the polyline with more than 2 decimals. See the calculations in test.dwg. So I want in every calculation to have 2 decimals.

Can you help?

Thanks

#### ribarm

• Gator
• Posts: 3268
• Marko Ribar, architect
##### Re: Help: Calculate volume from contours
« Reply #4 on: June 13, 2023, 07:15:31 PM »
Code - Auto/Visual Lisp: [Select]
1. ...
2. (defun _rtos (n) (rtos n 2 2))
3. (defun _foo (e) (list (_rtos (vlax-curve-getarea e)) (_rtos (cdr (assoc 38 (entget e)))))
4. ...
5.
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### mhy3sx

• Newt
• Posts: 120
##### Re: Help: Calculate volume from contours
« Reply #5 on: June 14, 2023, 02:47:53 AM »
Hi ribarm. I add your code but is not working. I have this error

Code: [Select]
`Command: TESTSelect objects: Specify opposite corner: 6 foundSelect objects:; error: bad argument type: numberp: "712.46"`
Code: [Select]
`(defun c:test (/ _foo _rtos a b r s v)  ;; RJP » 2021-09-17  (defun _rtos (n) (rtos n 2 2))  (defun _foo (e) (list (_rtos (vlax-curve-getarea e)) (_rtos (cdr (assoc 38 (entget e))))))  (cond ((and (setq s (ssget '((0 . "*polyline") (-4 . "&=") (70 . 1))))       (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))) ) (setq s (mapcar '_foo s)) (setq s (vl-sort s '(lambda (r j) (> (car r) (car j))))) (while (cadr s)    (setq a (car s) b (cadr s) s (cdr s)    )    ;; Average of areas multiplied by height = volume    (setq v   (* (/ (apply '+ (mapcar 'car (list a b))) 2) (abs (apply '- (mapcar 'cadr (list a b)))))    )    (princ (strcat "\n("   (_rtos (cadr a))   " - "   (_rtos (cadr b))   ") = "   (_rtos v) " m3"   )    )    (setq r (cons v r)) ) (princ (strcat "\nV = " (_rtos (apply '+ r))" m3")) (textscr) )  )  (princ))`
Thanks

#### mhy3sx

• Newt
• Posts: 120
##### Re: Help: Calculate volume from contours
« Reply #6 on: June 14, 2023, 06:02:00 AM »
Can any one explain me how to create a table and insert the results in raws and columns ?

Code: [Select]
`(defun c:test2 (/ _foo _rtos a b r s v)  ;; RJP » 2021-09-17  (defun _foo (e) (list (vlax-curve-getarea e) (cdr (assoc 38 (entget e)))))  (defun _rtos (n) (rtos n 2 2))    (cond ((and (setq s (ssget '((0 . "*polyline") (-4 . "&=") (70 . 1))))     (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))) ) (setq s (mapcar '_foo s)) (setq s (vl-sort s '(lambda (r j) (> (car r) (car j))))) (while (cadr s)    (setq a (car s) b (cadr s) s (cdr s)    )    ;; Average of areas multiplied by height = volume    (setq v   (* (/ (apply '+ (mapcar 'car (list a b))) 2) (abs (apply '- (mapcar 'cadr (list a b)))))    )           (setq ar                  (/ (apply '+ (mapcar 'car (list a b))) 2)           )           (setq dh                    (abs (apply '- (mapcar 'cadr (list a b))))           )     (princ (strcat "\n(" (_rtos (cadr a)) " - "  (_rtos (cadr b)) ")  " (_rtos ar) " m2   "  (_rtos dh) " m    "  (_rtos v) " m3" ))    (setq r (cons v r)) ) (princ (strcat "\nV = " (_rtos (apply '+ r))" m3")) (textscr) )  )  (princ))`
Thanks

#### mhy3sx

• Newt
• Posts: 120
##### Re: Help: Calculate volume from contours
« Reply #7 on: June 14, 2023, 09:29:27 AM »
The idea is a table like attach image. I Need help to fill the columns A1, A2

Code - Auto/Visual Lisp: [Select]
1. (defun c:test2  (/ _foo _rtos a b r s v)
2.   ;; RJP » 2021-09-17
3.   (defun _foo (e) (list (vlax-curve-getarea e) (cdr (assoc 38 (entget e)))))
4.   (defun _rtos (n) (rtos n 2 2))
5.     (cond ((and (setq s (ssget '((0 . "*polyline") (-4 . "&=") (70 . 1))))
6.             (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
7.          )
8.          (princ (strcat "\n                Calculate volume from contours                   " ))
9.          (princ (strcat "\n-----------------------------------------------------------------"))
10.          (princ (strcat "\nElevation    (A1+A2) x Dh x 0.50       Dh             V"))
11.          (setq s (mapcar '_foo s))
12.          (setq s (vl-sort s '(lambda (r j) (> (car r) (car j)))))
13.          (princ (strcat "\n-----------------------------------------------------------------"))
15.            (setq a (car s)
17.                  s (cdr s)
18.            )
19.            ;; Average of areas multiplied by height = volume
20.            (setq v
21.                   (* (/ (apply '+ (mapcar 'car (list a b))) 2) (abs (apply '- (mapcar 'cadr (list a b)))))
22.            )
23.
24.            (setq ar
25.                  (/ (apply '+ (mapcar 'car (list a b))) 2)
26.            )
27.            (setq dh
28.                    (abs (apply '- (mapcar 'cadr (list a b))))
29.            )
30.
31.
32.             (princ (strcat "\n(" (_rtos (cadr a)) " - "  (_rtos (cadr b)) ")  "   (_rtos ar) " m2   "  (_rtos dh) " m    "  (_rtos v) " m3" ))
33.            (setq r (cons v r))
34.          )
35.          (princ (strcat "\n-----------------------------------------------------------------"))
36.          (princ (strcat "\nV = " (_rtos (apply '+ r))" m3"))
37.          (textscr)
38.         )
39.   )
40.   (princ)
41. )
42.

Perhaps is more correct like this

Code - Auto/Visual Lisp: [Select]
1.          (princ (strcat "\nElevation               A1            A2            Dh            (A1+A2) x Dh x 0.50           V"))
2.

#### ronjonp

• Needs a day job
• Posts: 7528
##### Re: Help: Calculate volume from contours
« Reply #8 on: June 14, 2023, 10:40:10 AM »
Hi ronjonp. If you see in the first post I already have

Code: [Select]
`  (defun _rtos (n) (rtos n 2 2)) ; for 2 decimals`

But if you see the test.dwg file the volumes are not correct, because in this line

Code: [Select]
`  (defun _foo (e) (list (vlax-curve-getarea e) (cdr (assoc 38 (entget e))))`
the area is calculated from the polyline with more than 2 decimals. See the calculations in test.dwg. So I want in every calculation to have 2 decimals.

Can you help?

Thanks
You are introducing rounding errors if you truncate to two decimals while adding up the total volume...

There are many rounding functions to be used, the best here: http://www.lee-mac.com/round.html

Try to incorporate that into the output not within the total calculation.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

#### ribarm

• Gator
• Posts: 3268
• Marko Ribar, architect
##### Re: Help: Calculate volume from contours
« Reply #9 on: June 14, 2023, 02:13:32 PM »
Hi ribarm. I add your code but is not working. I have this error

Code: [Select]
`Command: TESTSelect objects: Specify opposite corner: 6 foundSelect objects:; error: bad argument type: numberp: "712.46"`

Code: [Select]
`  (defun _foo (e) (princ (strcat (_rtos (vlax-curve-getarea e)) " " (_rtos (cdr (assoc 38 (entget e))))))`
« Last Edit: June 14, 2023, 03:58:09 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### BIGAL

• Swamp Rat
• Posts: 1409
• 40 + years of using Autocad
##### Re: Help: Calculate volume from contours
« Reply #10 on: June 14, 2023, 08:15:08 PM »
Example of make a table.

Code: [Select]
`; make table example; By Alan H info@alanh.com.au; 2018(defun c:ahmaketable (/ colwidth numcolumns numrows objtable rowheight sp vgad vgao vgms)(vl-load-com)(setq sp (vlax-3d-point (getpoint "pick a point for table")))(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) ;(setq numrows 5)(setq numcolumns 5)(setq rowheight 2.5)(setq colwidth 60)(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))(vla-settext objtable 0 0 "DRAWING REGISTER"); TABLE TITLE(vla-settext objtable 1 0 "DRAWING NUMBER") (vla-settext objtable 1 1 "DRAWING TITLE") (vla-settext objtable 1 2 "C")(vla-settext objtable 1 3 "D")(vla-settext objtable 1 4 "E")(vla-settext objtable 2 0 "1")(vla-settext objtable 3 0 "2")(vla-settext objtable 4 0 "3")(command "_zoom" "e")(princ))`Also
Code: [Select]
`(vla-insertrows objtable  numrows rowheight 1)`

#### mhy3sx

• Newt
• Posts: 120
##### Re: Help: Calculate volume from contours
« Reply #11 on: June 16, 2023, 02:12:24 PM »
Ηι BIGAL . I read this example , but in this example we have 5 columns and 3 rows , if I am correct. In test2.lsp we don't know how many contours we have, because is not standard. I don't know how this example will work in test2.lsp

Thanks

#### BIGAL

• Swamp Rat
• Posts: 1409
• 40 + years of using Autocad
##### Re: Help: Calculate volume from contours
« Reply #12 on: June 16, 2023, 09:25:18 PM »
You make the default header and 1st row plus 1 blank data row then use the INSERTROW function to keep adding a new row, you can then use the Vla-settext to add the data row by row.

The insertrow is inside a While etc whilst you read the contours. Just keep making (setq numrows (1+ numrows))

I have done like 100's of rows using this. No idea how many I need.

If you get into a big number of rows you need to turn off regen table as the rows are inserted then turn back on at end. Way faster.

#### mhy3sx

• Newt
• Posts: 120
##### Re: Help: Calculate volume from contours
« Reply #13 on: July 05, 2023, 10:47:52 AM »
I try this . can any one help?

Code - Auto/Visual Lisp: [Select]
1. can any one help me to fix this code
2.
4. (defun c:test2  (/ _foo _rtos a b r s v tbl)
5.   (defun _foo (e) (list (vlax-curve-getarea e) (cdr (assoc 38 (entget e)))))
6.   (defun _rtos (n) (rtos n 2 2))
7.   (setq tbl (vlax-make-safearray vlax-vbDouble (cons 1 6)))
8.
9.   (cond ((and (setq s (ssget '((0 . "*polyline") (-4 . "&=") (70 . 1))))
10.               (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
11.          )
12.          (setq s (mapcar '_foo s))
13.          (setq s (vl-sort s '(lambda (r j) (> (car r) (car j)))))
14.
15.          (setq row 0)
16.          (vlax-for val s
17.            (setq a (car val)
19.            )
20.
21.            ;; calculate the results
22.            (setq A1 (car a)
23.                  A2 (car b)
25.                  sum (* (+ A1 A2) Dh 0.50)
26.                  V (* A1 Dh 0.50)
27.            )
28.
29.            ;; insert the results in table
30.            (vla-put-value tbl (vlax-make-safearray-index (list (setq row (1+ row)) 0)) A1)
31.            (vla-put-value tbl (vlax-make-safearray-index (list row 1)) A2)
32.            (vla-put-value tbl (vlax-make-safearray-index (list row 2)) Dh)
33.            (vla-put-value tbl (vlax-make-safearray-index (list row 3)) sum)
34.            (vla-put-value tbl (vlax-make-safearray-index (list row 4)) V)
35.          )
36.
37.          ;; print table
38.          (princ "Elevation        A1            A2            Dh            (A1+A2) x Dh x 0.50        V")
39.          (setq row 0)
40.          (while (< (setq row (1+ row)) (vla-get-dim2 tbl 1))
41.            (setq A1 (vla-get-value tbl (vlax-make-safearray-index (list row 0)))
42.                  A2 (vla-get-value tbl (vlax-make-safearray-index (list row 1)))
43.                  Dh (vla-get-value tbl (vlax-make-safearray-index (list row 2)))
44.                  sum (vla-get-value tbl (vlax-make-safearray-index (list row 3)))
45.                  V (vla-get-value tbl (vlax-make-safearray-index (list row 4)))
46.            )
47.            (princ (strcat "\n" (_rtos A1) "         " (_rtos A2) "         " (_rtos Dh) "         " (_rtos sum) "         " (_rtos V)))
48.          )
49.          (princ)
50.   )
51. )
52.
53.

Thanks

[/code]

#### mhy3sx

• Newt
• Posts: 120
##### Re: Help: Calculate volume from contours
« Reply #14 on: July 06, 2023, 01:26:26 AM »
Any options?

Thanks