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