;;;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 24. Tablas.
(defun ins-tabla (/ pt altura-fila ancho-col nfilas ncols)Â
  (setq pt          (getpoint "\nEsquina superior izquierda de la tabla: ")
        altura-fila (getdist pt "\nAltura de filas: ")
        ancho-col   (getdist pt "\nAnchura de columnas: ")
        nfilas      (getint "\nNúmero de filas: ")
        ncols       (getint "\nNúmero de columnas: "))
  (vla-AddTableÂ
    (espacio-actual *aevl:dibujo*)
    (vlax-3d-point pt)
    nfilas
    ncols
    altura-fila
    ancho-col))
;;;Listado 24.1. Función que inserta una tabla en el dibujo.
(defun altura-texto-fila (obj-tabla i-fila altura-texto /)Â
  (setq i 0)
  (repeat (vla-get-Columns obj-tabla)Â
    (vla-setTextHeight2 obj-tabla i-fila i 0 altura-texto)
    (setq i (1+ i))))
;;;Listado 24.2. Función que cambia la altura de texto de una fila.
(defun altura-texto-columna (obj-tabla i-col altura-texto /)Â
  (setq i 0)
  (repeat (vla-get-Rows obj-tabla)Â
    (vla-setTextHeight2 obj-tabla i i-col 0 altura-texto)
    (setq i (1+ i))))
;;;Listado 24.3. Función que cambia la altura de texto para una columna.
(defun sel-bloque (nombre / ss obj cont ename datos lista-datos)Â
  (setq cont 0)
  (ifÂ
    (setq ss (ssget "X"Â
                    (list (cons 0 "INSERT") (cons 2 nombre))))
    (while (setq ename (ssname ss cont))Â
      (setq obj (vlax-ename->vla-object ename))
      (setq datos (listÂ
                    (cons "CAPA" (vla-get-layer obj))
                    (cons "COORDS"Â
                          (vlax-safearray->listÂ
                            (vlax-variant-valueÂ
                              (vla-get-insertionpoint obj))))))
      (setq lista-datos (consÂ
                          (append datosÂ
                                  (ax-lee-atributos ename))
                          lista-datos))
      (setq cont (1+ cont))))
  lista-datos)
;;;Listado 24.4. Selección del bloque a procesar y extracción de sus atributos a una lista.
(defun col-w (lista-datos ncols / lst-w max-c)Â
  (setq lst-w (mapcarÂ
                '(lambda (fila)Â
                   (mapcarÂ
                     '(lambda (cel)Â
                        (applyÂ
                          'max
                          (listÂ
                            (strlenÂ
                              (vl-princ-to-string (car cel)))
                            (strlenÂ
                              (vl-princ-to-string (cdr cel))))))
                     fila))
                lista-datos)
        i     0)
  (repeat ncolsÂ
    (setq max-c (consÂ
                  (apply 'maxÂ
                         (mapcar '(lambda (x) (nth i x)) lst-w))
                  max-c))
    (setq i (1+ i)))
  (reverse max-c))
;;;Función que calcula los anchos relativos aproximados de las columnas.
(defun C:TABLA-ATRIBUTOS (/ *error* pres-act bloque nombre car-por-cols ancho-por-carÂ
                          lista-datos nfilas ncols pt-ins pt-esquina altura-filaÂ
                          ancho-tabla obj-tabla i j txt)Â
  (vla-StartUndoMark *aevl:dibujo*)
  (defun *error* (msg)Â
    (vla-EndUndoMark *aevl:dibujo*)
    (command-s "_U")
    (prompt msg))
  (if (/= (setq pres-act (getvar "CTAB")) "Model")Â
    (setvar "TILEMODE" 1))
  (whileÂ
    (notÂ
      (and (setq bloque (ssget "_:S" '((0 . "INSERT"))))Â
           (equalÂ
             (vla-get-HasAttributesÂ
               (vlax-ename->vla-object (ssname bloque 0)))
             :vlax-true)))
    (prompt "\nSelect a bloque with attributes: "))
  (setq nombre      (cdr (assoc 2 (entget (ssname bloque 0))))
        lista-datos (sel-bloque nombre)
        nfilas      (length lista-datos)
        ncols       (length (car lista-datos)))
  (setvar "CTAB" pres-act)
  (initget 1)
  (setq pt-ins (getpoint "\nSpecify table insertion point: "))
  (initget (+ 1 32))
  (setq pt-esquina  (getcorner pt-ins "\nSpecify table size: ")
        altura-fila   (/Â
                      (abs (- (nth 1 pt-ins) (nth 1 pt-esquina)))
                      (1+ nfilas))
        ancho-tabla (abs (- (nth 0 pt-esquina) (nth 0 pt-ins)))
        obj-tabla ; Creación de la tabla
                    (vla-AddTableÂ
                      (espacio-actual *aevl:dibujo*)
                      (vlax-3d-point pt-ins)
                      (1+ nfilas)
                      ncols
                      altura-fila
                      (/ ancho-tabla ncols)))
  (vla-put-RegenerateTableSuppressedÂ
    obj-tabla
    :vlax-true)
  ;;Las anchuras de columna se ajuatan a los contenidos
  (setq car-por-cols  (col-w lista-datos ncols)
        ancho-por-car (/Â
                        ancho-tabla
                        (apply '+ car-por-cols))
        i             0)
  (foreach w car-por-colsÂ
    (vla-SetColumnWidth obj-tabla i (* ancho-por-car w))
    (setq i (1+ i)))
  (vla-SetText obj-tabla 0 0 nombre) ; TÃtulo
  (setq i 0)
  (foreach dato (car lista-datos)Â
    (vla-SetText obj-tabla 1 i (car dato)) ; Cabecera
    (setq i (1+ i)))
  (setq i 0)
  (repeat (1- nfilas)  ; Filas de datos
    (setq j 0)
    (repeat ncolsÂ
      (vla-SetCellAlignmentÂ
        obj-tabla
        (+ i 2)
        j
        acMiddleCenter)
      (setq txt (vl-princ-to-stringÂ
                  (cdr (nth j (nth i lista-datos)))))
      (vla-SetText obj-tabla (+ i 2) j txt)
      (setq j (1+ j)))
    (setq i (1+ i)))
  (vla-put-RegenerateTableSuppressedÂ
    obj-tabla
    :vlax-false)
  (vla-EndUndoMark *aevl:dibujo*))
;;;Listado 24.5. Función principal C:TABLA-DATOS.
