Topic: Help volume from contours

[mhy3sx]

can any one help me to fix this code

Code - Auto/Visual Lisp: [Select]

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

Thanks

[DEVITG]

@mhy3sx. please upload the lost defund
 

vlax-make-safearray-index

 

[ribarm]

I could be wrong, but I suspect that missing functions look like this :

Code - Auto/Visual Lisp: [Select]

1. (defun vlax-make-safearray-index (lst) (vlax-safearray-fill lst))
2. (defun vla-get-dim2 (a b) (- (safearray-get-dim a) b))
3.