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

(defun C:XCAPA (/) 
  (command "_OPENDCL")
  (dcl-Project-Load (findfile "./XCapa/XCapa.odcl"))
  (dcl_form_show XCapa_frmPal))
		;;;Listado 27.1. Función que implementa el nuevo comando XCAPA.

;;;(defun c:XCapa_frmPal_OnInitialize (/)
;;;  (dcl_MessageBox
		;;;    "To Do: code must be added to event handler\r\nc:XCapa_frmPal_OnInitialize"
;;;    "To do"))
		;;;Listado 27.2. Listado de la función plantilla creada por el editor ODCL.

(defun lis-dib (/ col-bloques lst-xref) 
  (setq col-bloques (vla-get-Blocks *aevl:dibujo*))
  (vlax-for bloque 
            col-bloques
            (if (equal (vla-get-IsXref bloque) :vlax-true) 
              (setq lst-xref (cons (vla-get-name bloque) lst-xref))))
  (setq lst-xref (acad_strlsort lst-xref)
        lst-xref (cons (getvar "DWGNAME") lst-xref)))
		;;;Listado 27.3. Función que obtiene la lista de dibujos insertados.

(defun lis-capa (/ col-capas lst-capas) 
  (setq col-capas (vla-get-Layers *aevl:dibujo*))
  (vlax-for capa 
            col-capas
            (setq lst-capas (cons (vla-get-Name capa) lst-capas)))
  (acad_strlsort lst-capas))
		;;;Listado 27.4. Función que obtiene la lista de capas.

(defun dib-capa (dibujos capas / actual pos tmp0 tmp1 res0 res1) 
  (setq actual (getvar "dwgname"))
  (foreach dibujo dibujos 
    (foreach capa capas 
      (cond 
        ((setq pos (vl-string-search "|" capa))
         (if (wcmatch capa (strcat dibujo "|*")) 
           (setq tmp0 (cons (substr capa (+ pos 2)) tmp0))))
        (t
         (if (= dibujo actual) 
           (setq tmp1 (cons capa tmp1))))))
    (cond 
      (tmp1
       (setq res1 (cons (cons actual (acad_strlsort tmp1)) res1)))
      (tmp0
       (setq res0 (cons (cons dibujo (acad_strlsort tmp0)) res0))))
    (setq tmp0 nil
          tmp1 nil))
  (append res1 (reverse res0)))
		;;;Listado 27.5. Función que crea la lista de asociación de dibujos y capas.

(defun crea-nodos (arbol / res_raiz res_refx id-img sel-img res_capa) 
  (setq res_raiz (dcl_tree_addparent XCapa_frmPal_trcCapas "Todo"))
		  (dcl_Tree_SetItemImages XCapa_frmPal_trcCapas res_raiz 0 1)
  (foreach refx arbol 
    (setq res_refx (dcl_tree_addchild 
                     XCapa_frmPal_trcCapas
                     res_raiz
                     (car refx)))
    (if (= (getvar "dwgname") (car refx)) 
      (setq id-img  2
            sel-img 3)
      (setq id-img  4
            sel-img 5))
    (dcl_tree_setitemimages 
      XCapa_frmPal_trcCapas
      res_refx
      id-img
      sel-img)
    (foreach capa (cdr refx) 
      (setq res_capa (dcl_Tree_AddChild 
		                       XCapa_frmPal_trcCapas
                       res_refx
                       capa))
      (dcl_Tree_SetItemImages 
        XCapa_frmPal_trcCapas
        res_capa
        6
        7)
		      (dcl_tree_expanditem XCapa_frmPal_trcCapas res_raiz 1)
		      (dcl_tree_selectitem XCapa_frmPal_trcCapas res_raiz))))
		;;;Listado 27.6. Función que crea los nodos del árbol.

(defun pinta-botones (sel-capa / activa lst-activa) 
  (foreach capa (lista-capas) 
    (if (wcmatch capa sel-capa) 
      (progn (setq activa (cdr (assoc 62 (tblsearch "LAYER" capa)))) 
             (if (minusp activa) 
               (setq lst-activa (cons nil lst-activa))
               (setq lst-activa (cons t lst-activa))))))
  (btn-act (comprueba-estado lst-activa)))
		;;;Listado 27.7. Función auxiliar PINTA-BOTONES.

(defun comprueba-estado (lista / resultado) 
  (cond 
    ((apply 'and lista) (setq resultado 1))
    ((apply 'or lista) (setq resultado 0))
    (t (setq resultado -1)))
  resultado)
;;;Listado 27.8. Función COMPRUEBA-ESTADO.

(defun btn-act (estado) 
  (cond 
    ((= estado 1)
		     (dcl_Control_SetPicture XCapa_frmPal_btnACT 100)
		     (dcl_Control_SetMouseOverPicture XCapa_frmPal_btnACT 107))
    ((= estado 0)
		     (dcl_Control_SetPicture XCapa_frmPal_btnACT 101)
		     (dcl_Control_SetMouseOverPicture XCapa_frmPal_btnACT 108))
    (t
		     (dcl_Control_SetPicture XCapa_frmPal_btnACT 102)
		     (dcl_Control_SetMouseOverPicture XCapa_frmPal_btnACT 109))))
		;;;Listado 27.9. Función que cambia la imagen del botón btnACT.

(defun guarda-estado (/ num) 
  (if 
    (setq num (car 
                (vl-sort 
                  (vl-remove-if-not 
                    '(lambda (l) (wcmatch l "*_XCapa"))
                    (layerstate-getnames))
                  '>)))
    (setq num (1+ (atoi num)))
    (setq num 1))
  (layerstate-save (strcat (itoa num) "_XCapa") (+ 1 32) nil))
		;;;Listado 27.10 Función que guarda el estado de la Capa.

(defun estado-previo (/ estados actual previo) 
  (setq estados (vl-sort 
                  (vl-remove-if-not 
                    '(lambda (l) (wcmatch l "*_XCapa"))
                    (layerstate-getnames))
                  '>))
  (if estados 
    (progn 
      (setq actual (car estados)
            previo (cadr estados))
      (if previo 
        (progn (layerstate-restore previo) 
               (layerstate-delete actual)
               (if (= (getvar "CTAB") "Model") 
                 (vla-Regen *aevl:dibujo* acActiveViewport)
                 (vla-Regen *aevl:dibujo* acAllViewports)))
        (prompt "\nNingún Estado de Capas previo guardado.")))))
		;;;Listado 27.11 Función que restaura un estado de Capa anterior.

(defun init-estados (/ estados) 
  (if 
    (setq estados (vl-remove-if-not 
                    '(lambda (ec) (wcmatch ec "*_XCapa"))
                    (layerstate-getnames)))
    (mapcar 'layerstate-delete estados))
  (layerstate-save "0_XCapa" (+ 1 32) nil))
		;;;Listado 27.12 Función de inicialización de estados de Capa.

(defun inicia-vista (/ arbol) 
  (setq arbol (dib-capa (lis-dib) (lis-capa)))
  (crea-nodos arbol)
  (setq *XCapa* "*")
  (pinta-botones *XCapa*))
		;;;Listado 27.13. Función que llena la vista en árbol.

(defun c:XCapa_frmPal_OnInitialize (/) 
  (init-estados)
  (inicia-vista))
		;;;Listado 27.14. Código definitivo para el evento Initialize del formulario.

(defun c:XCapa_frmPal_trcCapas_OnSelChanged (Label Key / s-list) 
  (setq s-list (cons Label s-list))
  (while (setq Key (dcl_Tree_GetParentItem XCapa_frmPal_trcCapas Key)) 
    (setq s-list (cons 
		                   (dcl_Tree_GetItemLabel XCapa_frmPal_trcCapas Key)
                   s-list)))
  (cond 
    ((= (length s-list) 1) (setq *XCapa* "*"))
    ((and (= (length s-list) 2) 
          (= (nth 1 s-list) (getvar "DWGNAME")))
     (setq *XCapa* "~*|*"))
    ((= (length s-list) 2)
     (setq *XCapa* (strcat (nth 1 s-list) "|*")))
    ((and (= (length s-list) 3) 
          (= (nth 1 s-list) (getvar "DWGNAME")))
     (setq *XCapa* (nth 2 s-list)))
    (t (setq *XCapa* (strcat (nth 1 s-list) "|" (nth 2 s-list)))))
  (pinta-botones *XCapa*))
		;;;Listado 27.15. Respuesta al evento SelChanged del control Tree.

(defun c:XCapa_frmPal_OnDocActivated (/) 
  (dcl_Tree_Clear XCapa_frmPal_trcCapas)
  (inicia-vista))
		;;;Listado 27.16. Función de respuesta al evento DocActivated.

(defun c:XCapa_frmPal_OnEnteringNoDocState (/) 
  (dcl_Form_CloseAll 64))
		;;;Listado 27.17. Código para el evento EnteringNoDocState.

(defun c:XCapa_frmPal_btnACT_OnClicked (/) 
  (if (= (dcl_Control_GetPicture XCapa_frmPal_btnACT) 100) 
    (progn (activa-capa *XCapa* (lis-capa) :vlax-false) 
		           (dcl_Control_SetPicture XCapa_frmPal_btnACT 102)
		           (dcl_Control_SetMouseOverPicture XCapa_frmPal_btnACT 109))
    (progn (activa-capa *XCapa* (lis-capa) :vlax-true) 
		           (dcl_Control_SetPicture XCapa_frmPal_btnACT 100)
		           (dcl_Control_SetMouseOverPicture XCapa_frmPal_btnACT 107)))
  (vla-update *aevl:acad*)
  (guarda-estado))
		;;;Listado 27.18. Respuesta al evento Clicked del btnACT.

(defun activa-capa (patron lista estado / col-capas) 
  (setq col-capas (vla-get-layers *aevl:dibujo*))
  (foreach capa lista 
    (if (wcmatch capa patron) 
      (vla-put-layeron (vla-item col-capas capa) estado))))
		;;;Listado 27.19. Función que activa o desactiva capas.

(defun c:XCapa_frmPal_btnCOLOR_OnClicked (/) 
  (if (setq s-col (acad_colordlg 256 t)) 
    (progn (setq col-capas (vla-get-layers *aevl:dibujo*)) 
           (vlax-for capa 
                     col-capas
                     (if (wcmatch (vla-get-name capa) *XCapa*) 
                       (progn (vla-put-color capa s-col))))
           (if (= (getvar "CTAB") "Model") 
             (vla-Regen *aevl:dibujo* acActiveViewport)
             (vla-Regen *aevl:dibujo* acAllViewports))
           (guarda-estado))))
		;;;Listado 27.20. Función de respuesta para el evento Clicked de botón btnCOLOR.

(defun c:XCapa_frmPal_btnAISLA_OnClicked (/) 
  (setq col-capas (vla-get-layers *aevl:dibujo*))
  (foreach capa (lis-capa) 
    (if (wcmatch capa *XCapa*) 
      (vla-put-LayerOn (vla-item col-capas capa) :vlax-true)
      (vla-put-LayerOn (vla-item col-capas capa) :vlax-false)))
  (pinta-botones *XCapa*)
  (vla-update *aevl:acad*)
  (guarda-estado))
		;;;Listado 27.21. Función de respuesta al evento Clicked del control btnAISLA.

(defun c:XCapa_frmPal_btnDESH_OnClicked (/) 
  (estado-previo)
  (pinta-botones "*"))
		;;;Listado 27.22. Función de respuesta al evento Clicked del botón btnDESH.

(defun c:XCapa_frmPal_btnRENOV_OnClicked (/) 
  (dcl_Tree_Clear XCapa_Trv_Capas)
  (inicia-vista))
		;;;Listado 27.23. Función de respuesta al evento Clicked del botón btnRENOV.