Ayuda con una rutina de áreas.

Buen día a todos.
La siguiente rutina obtiene el área de un poligono cerrado y coloca un texto con el valor del área en el lugar en que lo indiquemos.
Modifiqué un poco la rutina original (disculpas a don Royé A. Flores Arce) para que el área esté redondeada al metro.

Código:

               ;  Esta rutina permite calcular el área de
               ;  polígono cerrados, y escribe dentro de él
               ;  el valor correspondiente al punto donde
               ;  picó con el cursor
               ;
               ;  Elaborado por Royé A. Flores Arce  DIBUJO DIGITAL S. A.
               ;                 Tel.  256-2181


(defun c:ba ()
  (setvar "CMDECHO" 0)
  (command "color" "bylayer")
  (command "_UNITS" "2" "3" "2" "3" "90" "_Y")
  (command "_setvar" "angdir" "1")
  (command "_setvar" "angbase" "270")
  (command "_LAYER" "_M" "Areas" "_C" "4" "" "")
  (vl-cmdf "_setvar" "dimzin" "1")
  (setq ba_ 1)
  (setq osn (getvar "osmode"))
  (if (= Ht nil)
    (setq Ht 1)
  )
  (graphscr)
  (setq Hn (rtos Ht 2 1))
  (setq Rotu (strcat "\nAltura del del texto para el Area? <" Hn "> "))
  (setq Hn (getreal Rotu))
  (if (/= Hn nil)
    (setq Ht Hn)
  )
  (setq pt (getpoint "\nPique dentro de un area cerrada "))

  (while pt
    (setvar "clayer" "Areas")
    (command "_boundary" "a" "i" "n" "" "" pt "")
    (command "_area" "_e" "_l")
    (command "_erase" "_l" "")
    (setq ar (getvar "area"))

    (setq ar (fix (+ ar (if (minusp ar) -0.5 0.5))))
   
    (setq ar (rtos ar 2 2))
    (setq tx (strcat ar " m² "))
    (command "_text" Pt Ht "90" tx)
    (setvar "clayer" "0");capa cero
    (setq pt (getpoint "\nPique dentro de un area cerrada "))
  )
  (command "_redraw")
  (setvar "clayer" "0");capa cero
  (command "_setvar" "osmode" osn)
  (setq mens (strcat ar " "))
  (prompt mens)
  (terpri)
)




Para el redondeo del área encontré esta formula:
(setq ar (fix (+ ar (if (minusp ar) -0.5 0.5))))
en donde ar es el area del poligono.
Buscando más, encontré una publicación del señor REINALDO N. TOGORES en la que indica como definir una función ROUND de redondeo:

(defun round (num)
(read (rtos num 2 0))
) ;_ fin de defun

Dice don Reinaldo:

"Hasta ahí bien, pero para 6.5 esta función realizaría la aproximación al entero mayor, que en este caso sería 7. Con lo que no se cumpliría la definición propuesta para la norma de Common LISP, donde se especifica que:

si el número se encuentra exactamente a mitad de camino entre dos enteros (es decir, en la forma entero + 0.5), entonces se redondea al entero par más próximo (divisible por 2). (Steele, CLTL2)

Para cumplir esta especificación deberemos desarrollar una función más compleja, que llamaremos CL-ROUND, siguiendo la norma citada.

Esta función requerirá un predicado tambén norma de Common LISP, pero ausente aún de AutoLISP-Visual LISP. El predicado EVENP que comprueba si un número entero es par.

(defun evenp (num)
(zerop (rem num 2))
) ;_ fin de defun

La nueva función cl-round recibe el número del cual comprueba:

si una vez redondeado el resultado NO es par (not (evenp (setq tmp (rnd num))))
si la parte decimal (valor absoluto) es igual a 0.5 (=(abs (rem num 1)) 0.5)
En caso de que ambas condiciones sean ciertas:

si el número es negativo, se le suma 1
si el número es positivo se le resta 1

(defun cl-round (num / tmp)
(if
(and
(not (evenp (setq tmp (rnd num))))
(= (abs (rem num 1)) 0.5)
)
(if (minusp tmp)(setq tmp (1+ tmp))(setq tmp (1- tmp)))
) ;_ fin de if
tmp
) ;_ fin de defun "

http://www.togores.net/vl/curso/lisp/bases/funciones/usuario/defun-1/redondeo

Ahora la pregunta:
Como integro la funcion (defun cl-round) a la rutina que estoy usando?
Lo e intentado pero la verdad no lo consigo.

Les agrdezco la ayuda que puedan brindarme

Hola José Francisco . te adjunto modificado , hay una línea la de UNITS que da error .si quieres, va  mi correo: devitg@gmail.com
[code](defun round (num)
(read (rtos num 2 0))
) ;_ fin de defun
;****************************************************
(defun cl-round (num / tmp)
(if
(and
(not (evenp (setq tmp (round num)))); aquí estaba RND num
(= (abs (rem num 1)) 0.5)
)
(if (minusp tmp)(setq tmp (1+ tmp))(setq tmp (1- tmp)))
) ;_ fin de if
tmp
) ;_ fin de defun "
;****************************************************
(defun evenp (num)
(zerop (rem num 2))
) ;_ fin de defun

 ;  Esta rutina permite calcular el área de
              ;  polígono cerrados, y escribe dentro de él
              ;  el valor correspondiente al punto donde
              ;  picó con el cursor
              ;
              ;  Elaborado por Royé A. Flores Arce  DIBUJO DIGITAL S. A.
              ;                 Tel.  256-2181


(defun c:ba ()
 (setvar "CMDECHO" 1)
 (command "color" "bylayer")
;;;  (command "_UNITS" "2" "3" "2" "3" "90" "_Y");;da error
(command "_setvar" "angdir" "1")
 (command "_setvar" "angbase" "270")
 (command "_LAYER" "_M" "Areas" "_C" "4" "" "")
 (vl-cmdf "_setvar" "dimzin" "1")
 (setq ba_ 1)
 (setq osmode (getvar "osmode"))
 (setvar 'osmode 0)
 (if (= Ht nil)
   (setq Ht 1)
 )
 (graphscr)
 (setq Hn (rtos Ht 2 1))
 (setq Rotu (strcat "\nAltura del del texto para el Area? <" Hn "> "))
 (setq Hn (getreal Rotu))
 (if (/= Hn nil)
   (setq Ht Hn)
 )
 (setq pt (getpoint "\nPique dentro de un area cerrada "))

 (while pt
   (setvar "clayer" "Areas")
   (command "_boundary" "a" "i" "n" "" "" pt "")
   (command "_area" "_e" "_l")
   (command "_erase" "_l" "")
   (setq ar# (getvar "area"))
   
;(setq ar# 3.5)
   ;4
;  (setq ar# 2.5)
   ;2
(setq ar (cl-round ar#))

   ;(setq ar (fix (+ ar# (if (minusp ar#) -0.5 0.5))))
 
   (setq ar (rtos ar 2 2))
   (setq tx (strcat ar " m² "))
   (command "_text" Pt Ht "90" tx)
   (setvar "clayer" "0");capa cero
   (setq pt (getpoint "\nPique dentro de un area cerrada "))
 )
 (command "_redraw")
 (setvar "clayer" "0");capa cero
 (command "_setvar" "osmode" osn)
 (setq mens (strcat ar " "))
 (prompt mens)
 (terpri)
)
[/code]

Hola José F.

Me parece que es totalmente inncesario recurrir a una función de redondeo cuando al final estás conviertiendo el numero en texto con la función rtos, ya que esta efectúa el redondeo matemático universal.

_$ (rtos 5.5 2 0)
"6"
_$ (rtos 6.5 2 0)
"7"

Por aqui te dejo otra forma resumida de hacer lo mismo con menos codigo -usando funciones de autolisp en vez de comandos de autocad

Código:

(defun c:ba ( / varDZ pt enti area)
 (if (null Hn)
 (setq Hn 1)
 )
 (setq Hn (cond
 ( (getreal (strcat "\nAltura del texto para el Area? <" (rtos Hn 2 1) "> ")) )
 ( Hn )
 )
 varDZ (getvar "dimzin")
 )
 (setvar "dimzin" 1)
 
 (while (setq pt (getpoint "\nPique dentro de un area cerrada "))
 (setq enti (bpoly pt)
 area (vlax-get-property
 (vlax-ename->vla-object enti)
 "Area"
 )
 )
 (entdel enti)
 (entmake
 (list
 '(0 . "TEXT")
 '(8 . "Areas")
 (cons 10 pt) (cons 11 pt)
 (cons 40 Hn)
 (cons 1 (strcat (rtos area 2 0) " m²"))
 '(72 . 1) '(73 . 2)
 )
 )
 )
 (setvar "dimzin" varDZ)
)

Hola Gerardo.
El hecho es que RTOS no trabaja según el convenio de redondeo a par, el cual dice que
23,5 se redondea a 24
22,5 se redondea a 22
En cambio
(rtos 23,5 2 0) devuelve 24
(rtos 22,5 2 0) devuelve 23
Como es una convención, Autolisp no la sigue (no acuerda) y no pasa nada, pero muchas otras organizaciones sí, por caso la norma de Common Lisp que menciona Reinaldo Togores o IBM en https://www.ibm.com/docs/es/cognos-controller/10.4.2?topic=SS9S6B_10.4.2/com.ibm.swg.ba.cognos.ctrl_ug.doc/c_rulroundr.html
En la web hay muchísimo, por caso http://wwwae.ciemat.es/~oglez/docs/redondeo.html
Saludos

Ahhhhh

jeje, disculpas, lo había entendido al revés, que no se quería la norma que si estaba en common lisp.

En ese caso si, cambiar la línea del rtos por nuestro propio redondeo no es dificil.
Por ejemplo:

Código:

(cons 1
 (strcat
  (itoa (* (atoi (rtos (/ area 2.0) 2 0)) 2))
  "m²"
 )
)

Hola Gerardo
¡Muy bueno tu aporte!
Estuve probando tu 2da versión (redondeo a par) y funciona perfecto en Acad 2021 inglés.
La de don Royé modificada, cuando uno la usa varias veces, hace un ciclo de redondeos correctos (o buscados) seguido por otros "tradicionales" y vuelta a redondeos a par.
Supongo yo, que sé muy poco lisp, que debe ser cuestión de alguna variable temporal.
Pero la tuya hizo lo pedido por José Francisco sin importar la cantidad de puntos picados.
Muchas gracias y saludos.

Con gusto

Hay una funcion de Autolisp en la que no confio mucho, al punto que a veces suelo usar mi propia version: REM

Revisa si los errores que te da alguna versión es siempre con los mismos valores, entonces somete ese valor al redondeo

El problema con rem es que trabaja sobre numeros binarios, y para enteros los binarios dan identicos resultados que los decimales pero para numeros no enteros los redondeos cambian (1/10   1/100   1/100   VS   1/2   1/4   1/8   1/16...)

Por eso cuando se requiere exactitud me acostumbre a preferir ese poco ortodoxo metodo de (distof (rtos... en vez de compuestos con rem y fix