(defun c:poly1 nil
(command "_pline")
(while (= (getvar "cmdactive") 1)
(command pause)
)
(command)
(command "_Area" "_object" "_last")
(alert
(strcat
"Volumen: "
(rtos (* (getvar "Area") (getreal "\nAltura:")) 2 2)
"m³"
)
)
)
(defun c:poly2 ( / ptini puntos parar lectura codigo dato area altura)
(setq ptini (getpoint "\nPunto inicial")
puntos (list (list (car ptini)(cadr ptini)))
)
(prompt "\n _Siguiente punto (u=deshacer, intro o click derecho para terminar.):")
(while (null parar)
(setq lectura (grread t 12 0)
codigo (car lectura)
dato (cadr lectura)
)
(cond
( (= codigo 5)
(redraw)
(grvecs
(append
(if (> (length puntos) 1)
(cons 2 (apply 'append (mapcar 'list puntos (cdr puntos))))
)
(list -2 (car puntos) (list (car dato) (cadr dato)))
(list 251 (last puntos) (list (car dato) (cadr dato)))
)
)
)
( (= codigo 3)
(setq puntos (cons (list (car dato)(cadr dato)) puntos))
)
( (and (= codigo 2)
(member dato '(85 117))
(> (length puntos) 1)
)
(setq puntos (cdr puntos))
)
( (or (member codigo '(11 25))
(and (= codigo 2) (member dato '(13 32) ) )
)
(if (= codigo 11)(grread))
(if (> (length puntos) 2)
(progn
(redraw)
(entmake
(append
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length puntos))
)
(mapcar '(lambda(A)(cons 10 A)) (reverse puntos))
'((70 . 1))
)
)
(setq area (vla-get-Area (vlax-ename->vla-object (entlast)))
altura (getreal "\nAltura:")
)
)
)
(setq parar t)
)
)
)
(if (and area altura)
(alert (strcat "Area: " (rtos area 2 2) "m²"
"\nAltura: " (rtos altura 2 2) "m"
"\n\nVolumen: " (rtos (* area altura) 2 2) "m³"
)
)
)
)
