;;;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 6. Estructuras y Datos ActiveX--------------------------
;;;6.1 Matrices (Arrays)
(defun ax-cuadrada? (matriz / dim tmp)
(setq dim 1)
(repeat (vlax-safearray-get-dim matriz)
(setq tmp (cons
(- (vlax-safearray-get-u-bound matriz dim)
(vlax-safearray-get-l-bound matriz dim))
tmp)
dim (1+ dim)))
(apply '= tmp))
;;;Listado 6.1. Función AX CUADRADA?.
(defun ax-safearrayp (dato)
(eq (type dato) 'safearray))
;;;Listado 6.2. Predicado AX-SAFEARRAYP.
(defun ax-matriz->lista (s-arr)
(if (ax-safearrayp s-arr)
(vlax-safearray->list s-arr)))
;;;Listado 6.3. Función AX-MATRIZ->LISTA.
(defun ax-tipo-dato (lista)
(if
(apply 'and
(mapcar '(lambda (x y) (eq (type x) (type y)))
lista
(cdr lista)))
(ax-tipo (car lista))
vlax-vbVariant))
;;;Listado 6.4. Función AX TIPO-DATO.
(defun ax-tipo (dato)
(setq dato (type dato))
(cond
((eq dato 'INT) vlax-vbLong)
((eq dato 'REAL) vlax-vbDouble)
((eq dato 'STR) vlax-vbString)
((eq dato 'VLA-OBJECT) vlax-vbObject)
(t vlax-vbVariant)))
;;;Listado 6.5. Función AX-TIPO.
(defun ax-lista->matriz (lista)
(vlax-safearray-fill
(vlax-make-safearray
(ax-tipo-dato lista)
(cons 0 (1- (length lista))))
lista))
;;;Listado 6.6. Función AX-LISTA->MATRIZ.
;;;6.6 Procesamiento de Colecciones.--------------------------------
(defun ax-act-des (dibujo)
(vlax-map-collection
(vla-get-layers dibujo)
'(lambda (x)
(if (equal (vla-get-LayerOn x) :vlax-true)
(vla-put-LayerOn x :vlax-false)
(vla-put-LayerOn x :vlax-true)))))
;;;Listado 6.7. Función para activar/desactivar capas mediante ActiveX.
(defun ax-lista-capas (dibujo / capas)
(vlax-for capa
(vla-get-layers dibujo)
(setq capas (cons (vla-get-name capa) capas)))
(acad_strlsort capas))
;;;Listado 6.8. Obtención de una lista de las capas del dibujo mediante ActiveX.
(defun ax-lista-nombres (dibujo nombre / nombres)
(setq coleccion (vlax-get-property dibujo nombre))
(vlax-for obj
coleccion
(setq nombres (cons (vla-get-name obj) nombres)))
(acad_strlsort nombres))
;;;Listado 6.9. Función genérica para obtener los nombres de los objetos de una colección.
;;;6.7.Managing exceptions.
(defun tan~ (ang) (/ (sin ang) (cos ang)))
;;;Listado 6.10. Cálculo de tangente sin prever la división por cero.
(defun tan (ang / coseno)
(if (zerop (setq coseno (cos ang)))
1.8E+308
(/ (sin ang) coseno)))
;;;Listado 6.11. Cálculo de la tangente previendo la división por cero.
(defun ax-existe? (elemento colección)
(not
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-item
(list colección elemento)))))
;;;Listado 6.12. Comprobar si existe un elemento en una colección.
(defun ax-existe? (elemento colección / resultado)
(if
(not
(vl-catch-all-error-p
(setq resultado (vl-catch-all-apply
'vla-item
(list colección elemento)))))
resultado))
;;;Listado 6.13. Función AX-EXISTE? que devuelve el objeto-VLA.
