Capítulo 7.lsp

		;;;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.