[编程交流] autolisp对话框中的默认复选框。。

:toggle {
    label = "Select All" ;
    key = "t2" ;
    value = "1" ;
}

;;;---------------------------------------------------------------------;;;
;;;  MatchAtts.lsp                                                      ;;;
;;;  Created by Will DeLoach                                            ;;;
;;;  Copyright 2005                                                     ;;;
;;;                                                                     ;;;
;;;FUNCTION                                                             ;;;
;;;Creates a variable sized dialog box with attribute tagstrings from the;;
;;;the Source Attribute.  The user selects the values they want to match;;;
;;;and then selects blocks withe same name as the source block and the  ;;;
;;;selected attributes will be changed to match the source attribute.   ;;;
;;;                                                                     ;;;
;;;USAGE                                                                ;;;
;;;(load "matchatts)                                                    ;;;
;;;matchatts                                                            ;;;
;;;                                                                     ;;;
;;;PLATFORMS                                                            ;;;
;;;Tested on 2006; but could work for earlier versions.                 ;;;
;;;                                                                     ;;;
;;;VERSION                                                              ;;;
;;; 1.0   October 3, 2005                                               ;;;
;;; 1.01  October 4, 2005   Fixed Att Selection for Attributes only.    ;;;
;;; 1.02  October 5, 2005   Fixed bug in cond statement                 ;;;
;;; 1.03  November 15, 2005   Replaced get_att SUBR (recmd by T. Willey);;;
;;; 1.1   April 6, 2006   Modifications made by CAB from theSwamp.org   ;;;
;;;                       Fixed duplicate tagname bug.                  ;;;
;;; 1.11  Added the write_line function.                                ;;;
;;; 1.2   Fixed block selection to work with Dynamic Blocks.            ;;;
;;; 1.21  Corrected an error with 'EffectiveName' assumption.           ;;;
;;;                                                                     ;;;
;;;                                                                     ;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED      ;;;
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR   ;;;
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.             ;;;
;;;                                                                     ;;;
;;;  You are hereby granted permission to use, copy and modify this     ;;;
;;;  software without charge, provided you do so exclusively for        ;;;
;;;  your own use or for use by others in your organization in the      ;;;
;;;  performance of their normal duties, and provided further that      ;;;
;;;  the above copyright notice appears in all copies and both that     ;;;
;;;  copyright notice and the limited warranty and restricted rights    ;;;
;;;  notice below appear in all supporting documentation.               ;;;
;;;                                                                     ;;;
;;;---------------------------------------------------------------------;;;
(defun c:matchatts (/      blk
 ;The entity name for the Reference Attribute
                    eblk ;Entity list of blk
                    atts ;List of attributes for 'blk'
                    tags ;List of 'tagstrings' for atts
                    keys ;List of 'handle' for atts
                    vals ;List of 'textstring' for atts
                    dcl_id ;Id number for the dialog box
                    dcl_name ;Name for the dialog box
                    strt ;Id from the done_dialog call
                    lst ;List of values for the toggles
                    ssa ;List of attributes the user selects
                    morder ;flag to chack att order, for future use
                    ename ;entity name
                    lst ;List of Keys
                    rname ;Reference Block Name
                    i ;Increment
                   )
;;;---------------------------------------------------------------------;;;
;;;A rewrite of the entsel function.                                    ;;;
;;;---------------------------------------------------------------------;;;
  (defun ent_sel (msg / ent)
    (while (not ent)
      (cond ((setq ent (entsel msg)))
            ((= (getvar "ErrNo") 7)
             (princ "\nSelection missed.  Please try again.")
            )
            ((= (getvar "ErrNo") 52) (exit))
      )
    )
    ent
  )
;;;---------------------------------------------------------------------;;;
;;;This is a utility function to return Attribute References for the    ;;;
;;;supplied object or entity name.                                      ;;;
;;;---------------------------------------------------------------------;;;
  (defun get_atts (obj)
    (vlax-invoke (vlax-ename->vla-object obj) 'getattributes)
  )
;;;---------------------------------------------------------------------;;;
;;;This creates a variable dialog box that changes size based on how    ;;;
;;;many attributes are passed to it.  The dialog box is temporary and is;;;
;;;created on the fly.  It is stored in your Acad Temp path location.   ;;;
;;;---------------------------------------------------------------------;;;
  (defun createdialog (lst keys / num tfn fn wid cnt str)
    (defun write_line (lst file) (foreach x lst (write-line x file)))
    (setq num (length tags))
    (cond ((> num 24) (setq wid 4))
          ((> num 12) (setq wid 3))
          ((> num 6) (setq wid 2))
          (T (setq wid 1))
    )
    (setq tfn (vl-filename-mktemp "match_attribute_value.dcl"))
    (setq fn (open tfn "w"))
    (write_line
      (list
        "temp : dialog { label = "Match Attributes";"
        ": boxed_column { label = "Select Attributes Values to Match: ";"
        ": row {"
      )
      fn
    )
    (setq cnt 0)
    (repeat (1+ wid)
      (write-line ": column {" fn)
      (repeat (/ num wid)
        (if (setq str (nth cnt lst))
          (progn (write-line
                   (strcat ": toggle { label = "
                           """
                           str
                           """
                           "; key = "
                           """
                           (nth cnt keys)
                           """
                           ";}"
                   )
                   fn
                 )
                 (setq cnt (1+ cnt))
          )
        )
      )
      (write-line "}" fn)
    )
    (write_line
      (list
        "}"
        "spacer_1;"
        " : toggle { key = "All"; label = "Select All";}"
        "}"
        "ok_cancel;"
        "}"
       )
      fn
    )
    (close fn)
    tfn
  )
;;;---------------------------------------------------------------------;;;
;;;This is the action for 'Select All' Check Box.                       ;;;
;;;---------------------------------------------------------------------;;;
  (defun on_all_pick (lst / str)
    (if (eq (get_tile "All") "0")
      (setq str "0")
      (setq str "1")
    )
    (mapcar '(lambda (x) (set_tile x str)) lst)
  )
;;;---------------------------------------------------------------------;;;
;;;This takes two lists and compares the two.  Every item in vals that  ;;;
;;;equals "1" is replace with the corresponding item in objs.           ;;;
;;;---------------------------------------------------------------------;;;
;;; CAB modified, create a list of pairs (tagname flag)  where flag 1 0 t/nil
  (defun create_list (vals objs)
    (vl-remove nil
               (mapcar '(lambda (x y)
                          (cons y
                                (if (eq x "1")
                                  1
                                  0
                                )
                          )
                        )
                       vals
                       objs
               )
    )
  )
;;;---------------------------------------------------------------------;;;
;;;Receives a Selection Set and returns Entity Names                    ;;;
;;;---------------------------------------------------------------------;;;
  (defun ssnames (selection_set / num lst)
    (repeat (setq num (sslength selection_set))
      (setq num (1- num)
            lst (cons (ssname selection_set num) lst)
      )
    )
    lst
  )
;;;---------------------------------------------------------------------;;;
;;;Accepts a Group code and an Entity List and returns the value.       ;;;
;;;---------------------------------------------------------------------;;;
  (defun dxf (gcode elist) (cdr (assoc gcode elist)))
;;;---------------------------------------------------------------------;;;
;;;---------------------------------------------------------------------;;;
;;;---------------------------------------------------------------------;;;
;;;Main program starts here.
  (while (not blk)
    (setq blk (car (ent_sel "\nSelect Source Object:  ")))
    (cond ((not (setq eblk (entget blk))))
          ((not (eq (dxf 0 eblk) "INSERT"))
           (setq blk nil)
           (princ "\nPlease select a block with attributes. ")
          )
          ((not (eq (dxf 66 eblk) 1))
           (setq blk nil)
           (princ "\nPlease select a block with attributes. ")
          )
          (T blk)
    )
  )
  (setq atts (get_atts blk)
        tags (mapcar 'vla-get-tagstring atts)
        keys (mapcar 'vla-get-handle atts)
        vals (mapcar 'vla-get-textstring atts)
  )
  (setvar "ErrNo" 0)
  (and ; Creates a temporary dialog box with toggles for each
 ; of the tagstrings in tags.  This is a variable dialog
 ; box that changes size based on the number of attributes.
    (setq dcl_name (createdialog tags keys)) ; Loads the dialog box
    (> (setq dcl_id (load_dialog dcl_name)) 0)
    (new_dialog "temp" dcl_id)
 ; If any toggle other than 'Select All' is pressed then
 ; this will turn off the 'Select All' toggle.
    (mapcar '(lambda (x) (action_tile x "(set_tile "All" "0")"))
            keys
    )
    (action_tile "All" "(on_all_pick keys)")
    (action_tile "cancel" "(done_dialog 0)")
    (action_tile
      "accept"
      "(setq lst (mapcar '(lambda (x)(get_tile x)) keys))(done_dialog 1)"
      ;;  CAB removed morder code
      ;; "(setq morder (= (get_tile "morder") "1")lst (mapcar '(lambda (x)(get_tile x)) keys))(done_dialog 1)"
    )
    ;;  (set_tile "morder" "1")
    (setq strt (start_dialog))
    (not (unload_dialog dcl_id))
    (vl-file-delete dcl_name)
    (setq morder t) ; overridefor now, keep for future use
    (if (eq strt 1)
      (and ; creates a list of attribute objects from the
 ; reference object that were selected in the dialog box.
        ;;  CAB start =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
        ;;  replace the attriburtes in one insert
        ;;  if morder is true the tag and the order in the list must match
        ;;  else the first matching tag will get the new value
        (defun replaceatts (ent atlst tags vals / blkobj cnt idx)
          (setq blkobj (vlax-ename->vla-object ent)
                cnt    0
          )
          (foreach atto (vlax-invoke blkobj 'getattributes)
            (cond
              ((and morder ; order must match
                    (= 1 (cdr (nth cnt atlst))) ; flag, ok to replace
                    (eq (vla-get-tagstring atto) (nth cnt tags))
               )
               (vla-put-textstring atto (nth cnt vals))
              )
              ((and
                 (not morder) ; ignore order
                 (= 1 (cdr (nth cnt atlst))) ; flag, ok to replace
                 (setq idx (vl-position (vla-get-tagstring atto) tags))
               )
               (vla-put-textstring atto (nth idx vals))
              )
            )
            (setq cnt (1+ cnt))
          )
          (vla-update blkobj)
        )
        ;; CAB - a list of pairs (tagname flag)  where flag 1 0 t/nil
        (setq atts (create_list lst atts))
        (not
          (prompt
            "\nSelect blocks to update or enter ALL for all matching blocks."
          )
        )
        (if
          (and
            (setq ssa (ssget (list '(0 . "INSERT") '(66 . 1))))
            (setq rname (vlax-ename->vla-object blk))
            (if (vlax-property-available-p rname 'effectivename)
              (progn (setq rname (vla-get-effectivename rname))
                     (mapcar '(lambda (x)
                                (if (/= rname
                                        (vla-get-effectivename
                                          (vlax-ename->vla-object x)
                                        )
                                    )
                                  (ssdel x ssa)
                                )
                              )
                             (ssnames ssa)
                     )
              )
              (progn
                (setq rname (vla-get-name rname))
                (mapcar
                  '(lambda (x)
                     (if (/= rname
                             (vla-get-name (vlax-ename->vla-object x))
                         )
                       (ssdel x ssa)
                     )
                   )
                  (ssnames ssa)
                )
              )
            )
          )
           (progn ;  itterate through the selected inserts
             (setq i -1)
             (while (setq ename (ssname ssa (setq i (1+ i))))
               (if (not (eq ename blk)) ; ignore doner block
                 (replaceatts ename atts tags vals)
               )
             )
             (if (= 0 (sslength ssa)) ;(not ssa);(null ssa)
               (princ "\nInvalid blocks selected.  Please start over. ")
             )
           )
        )
        ;;  CAB end =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
      ) ; This is returned if the user hits Cancel.
      (princ "\nFunction Terminated by User!")
    )
  )
  (princ)
)

    (write_line
      (list
        "}"
        "spacer_1;"
       ;;  replaced ** [s]" : toggle { key = "All"; label = "Select All";}"[/s]
        " : toggle { key = "All"; label = "Select All"; value = "1"; }"
        "}"
        "ok_cancel;"
        "}"
       )
      fn
    )