;;; Copyright © 2012-2020 by Reinaldo N. Togores. All rights reserved.
;;; Use of this code is allowed mentioning the book and its author.
;;;Chapter 27. OpenDCL.
(defun C:XLAYER (/)
(command "_OPENDCL")
(dcl-Project-Load (findfile "./XLayer/XLayer.odcl"))
(dcl_form_show XLayer_frmPal))
;;;Listing 27.1. Function that implements the new XLAYER command.
;;;(defun c:XLayer_frmPal_OnInitialize (/)
;;; (dcl_MessageBox
;;; "To Do: code must be added to event handler\r\nc:XLayer_frmPal_OnInitialize"
;;; "To do"))
;;;Listing 27.2. Template function created by OpenDCL Studio.
(defun dwg-list (/ blocks-coll xref-lst)
(setq blocks-coll (vla-get-Blocks *aevl:drawing*))
(vlax-for block
blocks-coll
(if (equal (vla-get-IsXref block) :vlax-true)
(setq xref-lst (cons (vla-get-name block) xref-lst))))
(setq xref-lst (acad_strlsort xref-lst)
xref-lst (cons (getvar "DWGNAME") xref-lst)))
;;;Listing 27.3. Function that retrieves the list of attached drawings.
(defun layer-list (/ layer-coll lay-lst)
(setq layer-coll
(vla-get-Layers *aevl:drawing*))
(vlax-for lyr
layer-coll
(setq lay-lst
(cons (vla-get-Name lyr) lay-lst)))
(acad_strlsort lay-lst))
;;;Listing 27.4. Function that retrieves the list of Layers.
(defun dwg-layers (drawings layers / current
pos tmp0 tmp1 res0 res1)
(setq current (getvar "dwgname"))
(foreach drawing drawings
(foreach lyr layers
(cond
((setq pos (vl-string-search "|" lyr))
(if (wcmatch lyr (strcat drawing "|*"))
(setq tmp0
(cons (substr lyr (+ pos 2)) tmp0))))
(t
(if (= drawing current)
(setq tmp1 (cons lyr tmp1))))))
(cond
(tmp1
(setq res1
(cons
(cons current (acad_strlsort tmp1)) res1)))
(tmp0
(setq res0
(cons
(cons drawing (acad_strlsort tmp0)) res0))))
(setq tmp0 nil
tmp1 nil))
(append res1 (reverse res0)))
;;;Listing 27.5. Function that creates the drawings and Layers association list.
(defun make-nodes
(tree / res_root res_xref id-img sel-img res_layer)
(setq res_root
(dcl_tree_addparent XLayer_frmPal_trcLayers "All"))
(dcl_Tree_SetItemImages
XLayer_frmPal_trcLayers
res_root
0
1)
(foreach refx tree
(setq res_xref (dcl_tree_addchild
XLayer_frmPal_trcLayers
res_root
(car refx)))
(if (= (getvar "dwgname") (car refx))
(setq id-img 2
sel-img 3)
(setq id-img 4
sel-img 5))
(dcl_tree_setitemimages
XLayer_frmPal_trcLayers
res_xref
id-img
sel-img)
(foreach lyr (cdr refx)
(setq res_layer (dcl_tree_addchild
XLayer_frmPal_trcLayers
res_xref
lyr))
(dcl_Tree_SetItemImages
XLayer_frmPal_trcLayers
res_layer
6
7)
(dcl_tree_expanditem XLayer_frmPal_trcLayers res_root 1)
(dcl_tree_selectitem XLayer_frmPal_trcLayers res_root))))
;;;Listing 27.6. Function that creates the Tree's nodes.
(defun draw-buttons (sel-layer / active active-lst)
(foreach lyr (layer-list)
(if (wcmatch lyr sel-layer)
(progn (setq active (cdr (assoc 62 (tblsearch "LAYER" lyr))))
(if (minusp active)
(setq active-lst (cons nil active-lst))
(setq active-lst (cons t active-lst))))))
(btn-act (check-state active-lst)))
;;;Listing 27.7. Auxiliary function DRAW-BUTTONS.
(defun check-state (lst / result)
(cond
((apply 'and lst) (setq result 1))
((apply 'or lst) (setq result 0))
(t (setq result -1)))
result)
;;;Listing 27.8. CHECK-STATE function.
(defun btn-act (state)
(cond
((= state 1)
(dcl_Control_SetPicture XLayer_frmPal_btnACT 100)
(dcl_Control_SetMouseOverPicture XLayer_frmPal_btnACT 107))
((= state 0)
(dcl_Control_SetPicture XLayer_frmPal_btnACT 101)
(dcl_Control_SetMouseOverPicture XLayer_frmPal_btnACT 108))
(t
(dcl_Control_SetPicture XLayer_frmPal_btnACT 102)
(dcl_Control_SetMouseOverPicture XLayer_frmPal_btnACT 109))))
;;;Listing 27.9. Function to change the btnACT button's image.
(defun save-state (/ num)
(if
(setq num (car
(vl-sort
(vl-remove-if-not
'(lambda (l) (wcmatch l "*_XLayer"))
(layerstate-getnames))
'>)))
(setq num (1+ (atoi num)))
(setq num 1))
(layerstate-save (strcat (itoa num) "_XLayer") (+ 1 32) nil))
;;;Listing 27.10. Function that saves the Layer State.
(defun prev-state (/ states current previous)
(setq states (vl-sort
(vl-remove-if-not
'(lambda (l) (wcmatch l "*_XLayer"))
(layerstate-getnames))
'>))
(if states
(progn
(setq current (car states)
previous (cadr states))
(if previous
(progn (layerstate-restore previous)
(layerstate-delete current)
(if (= (getvar "CTAB") "Model")
(vla-Regen *aevl:drawing* acActiveViewport)
(vla-Regen *aevl:drawing* acAllViewports)))
(prompt "\nNo previous LayerState saved.")))))
;;;Listing 27.11. Function that restores a previous Layer State.
(defun init-states (/)
(if
(setq states (vl-remove-if-not
'(lambda (l) (wcmatch l "*_XLayer"))
(layerstate-getnames)))
(mapcar 'layerstate-delete states))
(layerstate-save "0_XLayer" (+ 1 32) nil))
;;;Listing 27.12. Layer states initializing function.
(defun start-view (/ tree)
(setq tree (dwg-layers (dwg-list) (layer-list)))
(make-nodes tree)
(setq *XLayer* "*")
(draw-buttons *XLayer*))
;;;Listing 27.13. Function that populates the tree view.
(defun c:XLayer_frmPal_OnInitialize (/)
(init-states)
(start-view))
;;;Listing 27.14. Final code for the form's Initialize event.
(defun c:XLayer_frmPal_trcLayers_OnSelChanged (Label Key / s-list)
(setq s-list (cons Label s-list))
(while (setq Key (dcl_Tree_GetParentItem XLayer_frmPal_trcLayers Key))
(setq s-list (cons
(dcl_Tree_GetItemLabel XLayer_frmPal_trcLayers Key)
s-list)))
(cond
((= (length s-list) 1) (setq *XLayer* "*"))
((and (= (length s-list) 2)
(= (nth 1 s-list) (getvar "DWGNAME")))
(setq *XLayer* "~*|*"))
((= (length s-list) 2)
(setq *XLayer* (strcat (nth 1 s-list) "|*")))
((and (= (length s-list) 3)
(= (nth 1 s-list) (getvar "DWGNAME")))
(setq *XLayer* (nth 2 s-list)))
(t (setq *XLayer* (strcat (nth 1 s-list) "|" (nth 2 s-list)))))
(draw-buttons *XLayer*))
;;;Listing 27.15. Tree Control SelChanged event's callback function.
(defun c:XLayer_frmPal_OnDocActivated (/)
(dcl_Tree_Clear XLayer_frmPal_trcLayers)
(start-view))
;;;Listing 27.16. DocActivated event's callback function.
(defun c:XLayer_frmPal_OnEnteringNoDocState (/)
(dcl_Form_CloseAll 64))
;;;Listing 27.17. Code for the EnteringNoDocState event.
(defun c:XLayer_frmPal_btnACT_OnClicked (/)
(if (= (dcl_Control_GetPicture XLayer_frmPal_btnACT) 100)
(progn (activate-layer *XLayer* (layer-list) :vlax-false)
(dcl_Control_SetPicture XLayer_frmPal_btnACT 102)
(dcl_Control_SetMouseOverPicture XLayer_frmPal_btnACT 109))
(progn (activate-layer *XLayer* (layer-list) :vlax-true)
(dcl_Control_SetPicture XLayer_frmPal_btnACT 100)
(dcl_Control_SetMouseOverPicture XLayer_frmPal_btnACT 107)))
(vla-update *aevl:acad*)
(save-state))
;;;Listing 27.18. Event handler for the btnACT button's Clicked event.
(defun activate-layer (pattern lst state / layer-coll)
(setq layer-coll (vla-get-layers *aevl:drawing*))
(foreach lyr lst
(if (wcmatch lyr pattern)
(vla-put-layeron (vla-item layer-coll lyr) state))))
;;;Listing 27.19. Function that sets Layers On or Off.
(defun c:XLayer_frmPal_btnCOLOR_OnClicked (/)
(if (setq s-col (acad_colordlg 256 t))
(progn (setq layer-coll (vla-get-layers *aevl:drawing*))
(vlax-for lyr
layer-coll
(if (wcmatch (vla-get-name lyr) *XLayer*)
(progn (vla-put-color lyr s-col))))
(if (= (getvar "CTAB") "Model")
(vla-Regen *aevl:drawing* acActiveViewport)
(vla-Regen *aevl:drawing* acAllViewports))
(save-state))))
;;;Listing 27.20. Event handler function for the btnCOLOR button's Clicked event.
(defun c:XLayer_frmPal_btnISOLATE_OnClicked (/)
(setq layer-coll (vla-get-layers *aevl:drawing*))
(foreach lyr (layer-list)
(if (wcmatch lyr *XLayer*)
(vla-put-layeron (vla-item layer-coll lyr) :vlax-true)
(vla-put-layeron (vla-item layer-coll lyr) :vlax-false)))
(draw-buttons *XLayer*)
(vla-update *aevl:acad*)
(save-state))
;;;Listing 27.21. Event handler for the btnISOLATE button's Clicked event.
(defun c:XLayer_frmPal_btnUNDO_OnClicked (/)
(prev-state)
(draw-buttons "*"))
;;;Listing 27.22. Event handler for the btnUNDO button's Clicked event.
(defun c:XLayer_frmPal_btn_UPDATE_OnClicked (/)
(dcl_Tree_Clear XLayer_frmPal_trcLayers)
(start-view))
;;;Listing 27.23. Event handler for the btnUPDATE button's Clicked event.
No comments:
Post a Comment