[编程交流] DynamicBlockVisibilityChange。l

;;; ------------------------------------------------------------------------
;;;        DynamicBlockVisibilityChange.lsp v1.0
;;;
;;;        Copyright© 10.15.09
;;;        Alan J. Thompson (alanjt)
;;;        
;;;
;;;        Permission to use, copy, modify, and distribute this software
;;;        for any purpose and without fee is hereby granted, provided
;;;        that the above copyright notice appears in all copies and
;;;        that both that copyright notice and the limited warranty and
;;;        restricted rights notice below appear in all supporting
;;;        documentation.
;;;
;;;        The following program(s) are provided "as is" and with all faults.
;;;        Alan J. Thompson DOES NOT warrant that the operation of the program(s)
;;;        will be uninterrupted and/or error free.
;;;
;;;        Allows user to select a Dynamic block and change visibility state of
;;;        all or a selection set of occurances of specified block.
;;;
;;;        Revision History:
;;;
;;; ------------------------------------------------------------------------
(defun c:VC99 (/ *error* AT:ListSelect AT:TabFilter #Obj #Name #List #Vis #Choice #SS)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; error handler
 (defun *error* (#Message)
   (and *AcadDoc* (vla-endundomark *AcadDoc*))
   (and #Message
        (not (wcmatch (strcase #Message) "*BREAK*,*CANCEL*,*QUIT*"))
        (princ (strcat "\nError: " #Message))
   ) ;_ and
 ) ;_ defun
;list select dialog
;create a temp DCL multi-select list dialog from provided list
;value is returned in list form, DCL file is deleted when finished
;example: (setq the_list (AT:listselect "This is my list title" "Select items to make a list" "25" "30" "true" (list "object 1" "object 2" "object 3"))
;if mytitle is longer than defined width, the width will be ignored and it will fit to title string
;if mylabel is longer than defined width, mylabel will be truncated
;myheight and mywidth must be strings, not numbers
;mymultiselect must either be "true" or "false" (true for multi, false for single)
;created by: alan thompson, 9.23.08
;some coding borrowed from http://www.jefferypsanders.com (thanks for the DCL examples)
 (defun AT:ListSelect (mytitle ;title for dialog box
                       mylabel ;label right above list box
                       myheight ;height of dialog box !!*MUST BE STRING*!!
                       mywidth ;width of dialog box !!*MUST BE STRING*!!
                       mymultiselect ;"true" for multiselect, "false" for single select
                       mylist ;list to display in list box
                       / retlist readlist count item savevars fn fo valuestr dcl_id
                      )
   (defun saveVars (/ readlist count item)
     (setq retList (list))
     (setq readlist (get_tile "mylist"))
     (setq count 1)
     (while (setq item (read readlist))
       (setq retlist (append retList (list (nth item myList))))
       (while
         (and
           (/= " " (substr readlist count 1))
           (/= "" (substr readlist count 1))
         ) ;_ and
          (setq count (1+ count))
       ) ;_ while
       (setq readlist (substr readlist count))
     ) ;_ while
   ) ;defun
   (setq fn (vl-filename-mktemp "" "" ".dcl"))
   (setq fo (open fn "w"))
   (setq valuestr (strcat "value = "" mytitle "";"))
   (write-line (strcat "list_select : dialog {
           label = "" mytitle "";") fo)
   (write-line
     (strcat
       "          : column {
           : row {
             : boxed_column {
              : list_box {
                 label ="" mylabel
       "";
                 key = "mylist";
                 allow_accept = true;
                 height = " myheight ";
                 width = " mywidth ";
                 multiple_select = " mymultiselect
       ";
                 fixed_width_font = false;
                 value = "0";
               }
             }
           }
           : row {
             : boxed_row {
               : button {
                 key = "accept";
                 label = " Okay ";
                 is_default = true;
               }
               : button {
                 key = "cancel";
                 label = " Cancel ";
                 is_default = false;
                 is_cancel = true;
               }
             }
           }
         }
}"     ) ;_ strcat
;_ strcat
     fo
   ) ;_ write-line
   (close fo)
   (setq dcl_id (load_dialog fn))
   (new_dialog "list_select" dcl_id)
   (start_list "mylist" 3)
   (mapcar 'add_list myList)
   (end_list)
   (action_tile "cancel" "(setq ddiag 1)(done_dialog)")
   (action_tile "accept" "(setq ddiag 2)(saveVars)(done_dialog)")
   (start_dialog)
   (if (= ddiag 1)
     (setq retlist nil)
   ) ;_ if
   (unload_dialog dcl_id)
   (vl-file-delete fn)
   retlist
 ) ;defun
;;; Tab filter for ssget selection filtering
;;; Must use (list instead of '( to work
;;; Alan J. Thompson, 06.05.09
 (defun AT:TabFilter (/)
   (if (eq 2 (getvar "cvport"))
     (cons 410 "Model")
     (cons 410 (getvar "ctab"))
   ) ;_ if
 ) ;_ defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (vl-load-com)
 (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
 (vla-startundomark *AcadDoc*)
 (cond
   ((and
      (setq #Obj (car (entsel "\nSelect dynamic block: ")))
      (eq "INSERT" (cdr (assoc 0 (entget #Obj))))
      (setq #Obj (vlax-ename->vla-object #Obj))
      (eq (vla-get-isdynamicblock #Obj) :vlax-true)
      (not
        (vl-catch-all-error-p (setq #Name (vl-catch-all-apply 'vla-get-effectivename (list #Obj))))
      ) ;_ not
      (setq #List (car (vl-remove-if-not
                         '(lambda (x) (eq (vla-get-PropertyName x) "Visibility"))
                         (vlax-invoke #Obj 'GetDynamicBlockProperties)
                       ) ;_ vl-remove-if-not
                  ) ;_ car
      ) ;_ setq
      (setq
        #List (vl-sort
                (mapcar 'vlax-variant-value
                        (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues #List)))
                ) ;_ mapcar
                '<
              ) ;_ vl-sort
      ) ;_ setq
      (setq #Vis (car (AT:ListSelect
                        "Dynamic Visibilities" "Select visibility option:" "10" "5" "false" #List
                       ) ;_ AT:ListSelect
                 ) ;_ car
      ) ;_ setq
      (not (initget 0 "All Filtered"))
      (or (setq #Choice (getkword "\nAll or Filtered selection [All/Filtered] <All>: "))
          (setq #Choice "All")
      ) ;_ or
      (cond
        ((eq #Choice "All")
         (setq
           #SS (ssget "_X" (list '(0 . "INSERT") (cons 2 (strcat #Name ",`*U*")) (AT:TabFilter)))
         ) ;_ setq
        )
        ((eq #Choice "Filtered")
         (setq
           #SS (ssget ":L" (list '(0 . "INSERT") (cons 2 (strcat #Name ",`*U*")) (AT:TabFilter)))
         ) ;_ setq
        )
      ) ;_ cond
    ) ;_ and
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (if (eq (vl-catch-all-apply 'vla-get-effectivename (list x)) #Name)
        (foreach i (vlax-invoke x 'GetDynamicBlockProperties)
          (if (eq (vla-get-PropertyName i) "Visibility")
            (vl-catch-all-apply 'vla-put-value (list i #Vis))
          ) ;_ if
        ) ;_ foreach
      ) ;_ if
    ) ;_ vlax-for
    (vl-catch-all-apply 'vla-delete (list #SS))
   )
 ) ;_ cond
 (*error* nil)
 (princ)
) ;_ defun