;;;Código fuente del libro "Experto AutoCAD con Visual LISP"
;;; (c) 2012 Ediciones ARTUAL, S.L. Barcelona, España.
;;; (c) 2012-2020 Reinaldo Togores. Todos los derechos reservados
;;; Se permite su uso mencionando la obra y su autor.
;;;Capítulo 7. Entrada de datos.
(defun valor-por-defecto (func mensaje valor / tmp)
(if
(setq tmp (apply
func
(list
(strcat mensaje
"<"
(vl-princ-to-string valor)
">: "))))
tmp
valor))
;;;Listado 7.1. Solicitud de datos incluyendo valor predeterminado.
(defun cadena-por-defecto (mensaje valor / tmp)
(setq tmp (apply 'getstring
(list (strcat mensaje "<" valor ">: "))))
(if (/= tmp "")
tmp
valor))
;;;Listado 7.2. Solicitud de cadena con valor predeterminado.
(defun valor-con-opciones (funcion mensaje opciones / tmp)
(initget opciones)
(if
(setq tmp (apply
funcion
(list
(strcat mensaje
" ["
(vl-string-translate "/" " " opciones)
"]: "))))
tmp))
;;;Listado 7.3. Solicitud de datos incluyendo opciones.
(defun getfixnum (mensaje / tmp)
(initget 1)
(setq tmp (getreal mensaje))
(while (and tmp (not (< -2147483647.0 tmp 2147483647.0)))
(prompt
"Requiere un nº entero entre -2147483647 y 2147483647..\n")
(initget 1)
(setq tmp (getreal mensaje)))
(if (numberp tmp)
(fix tmp)
tmp))
;;;Listado 7.4. Función para obtener números enteros largos.
(defun id-bits (valor /)
(vl-remove 0
(mapcar '(lambda (i) (logand i valor))
'(1 2 4 8 16 32 64 128 256 512 1024 2048 4096 8192 16384 32768
65536))))
;;;Listado 7.5. Función para detectar los bits activados.
(defun bits-activos? (bits valor)
(= bits (logand bits valor)))
(defun activa-bits (bits valor)
(logior bits valor))
(defun anula-bits (bits valor)
(logand (~ bits) valor))
;;;Listado 7.6. Funciones para comprobar, activar o anular bits.
(defun conmuta-varsis (varsis bits)
(setvar varsis (boole 6 (getvar varsis) bits)))
;;;Listado 7.7. Conmutador de variables.
(defun cmd-entrar (/ 3dosm)
(if
(and (setq 3dosm (getvar "3DOSMODE"))
(not (bits-activos? (lsh 1 0) 3dosm)))
(conmuta-varsis "3DOSMODE" (lsh 1 0)))
(if (not (bits-activos? (lsh 1 14) (getvar "OSMODE")))
(conmuta-varsis "OSMODE" (lsh 1 14)))
(if (bits-activos? (lsh 1 0) (getvar "CMDECHO"))
(conmuta-varsis "CMDECHO" (lsh 1 0))))
;;;Listado 7.8. Ajuste de las variables de sistema antes de entrar al comando.
(defun cmd-salir (/ 3dosm)
(if
(and (setq 3dosm (getvar "3DOSMODE"))
(bits-activos? (lsh 1 0) 3dosm))
(conmuta-varsis "3DOSMODE" (lsh 1 0)))
(if (bits-activos? (lsh 1 14) (getvar "OSMODE"))
(conmuta-varsis "OSMODE" (lsh 1 14)))
(if (not (bits-activos? (lsh 1 0) (getvar "CMDECHO")))
(conmuta-varsis "CMDECHO" (lsh 1 0))))
;;;Listado 7.9. Restitución de los valores originales al salir del comando.
