Código Fuente‎ > ‎

Capítulo 6.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 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.