Скрипт по фильтрации блоков по их видимости

;;;From http://www.theswamp.org/index.php?topic=23944.0
;;; Thread  Dynamic block filter
;;; SSD R2.6 (gile) 14/07/2008 (last revision 19/12/2010)
;;; Select dynamic blocks according to dynamic properties values
;;; Using:
;;; To make a selection, enter ssd at command prompt or,
;;; within a modification command, type (ssd) at "Select objects: " prompt
;;; Select a source dynamic block
;;; Choose properties values to filter in the dialog box
;;; (an empty tile or an asterisk (*) means "all vlaue")
 
(defun ssd (/ *error* ToString DynBlkPropValue dz ss ent blk name pop fuzz ret sel res)
 
  (vl-load-com)
  (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))));;;Add VVA 2010-01-11
  (defun *error* (msg)
    (if (/= msg "Function cancelled")
      (princ (strcat "Error: " msg))
    )
    (setvar 'dimzin dz)
    (princ)
  )
 
  (defun ToString (v u)
    (cond
      ((= 0 u) (vl-princ-to-string v))
      ((= 1 u)(angtos v (getvar 'aunits) 16))  ;;;Correct VVA 2010-01-11
      ((if (< (abs v) 1e-6)
     (rtos v 1 6)
     (rtos v (getvar 'lunits) 12)
       )
      )
    )
  )
 
  ;; DynBlkPropValue
  ;; Dialog box to choose dynamic properties values
  ;;
  ;; Argument : the dynamic properties list (vla-object list)
 
  (defun DynBlkPropValue (lst / tmp file pn unt av dcl_id val)
    (setq tmp  (vl-filename-mktemp "Tmp.dcl")
      file (open tmp "w")
    )
    (write-line
      (strcat
    "DynBlkProps:dialog{label=\"Dynamic block filter\";"
    ":text{label=\"Block name: \""
    (vl-prin1-to-string name)
    ";}spacer;:boxed_column{label=\"Dynamic properties\";"
      )
      file
    )
    (foreach p lst
      (setq pn  (vla-get-PropertyName p)
        unt (vla-get-UnitsType p)
      )
      (cond
    ((setq av (vlax-get p 'AllowedValues))
     (setq av  (mapcar '(lambda (x) (ToString x unt)) av)
           pop (cons (vl-list* pn "*" av) pop)
     )
     (write-line
       (strcat
         ":popup_list{label="
         (vl-prin1-to-string pn)
         ";key="
         (vl-prin1-to-string pn)
         ";value="
         (itoa (1+ (vl-position (ToString (vlax-get p 'Value) unt) av)))
         ";edit_width=25;allow_accept=true;}"
       )
       file
     )
    )
    ((/= pn "Origin")
     (setq fuzz (cons pn fuzz))
     (write-line
       (strcat
         ":row{:edit_box{label="
         (vl-prin1-to-string pn)
         ";key="
         (vl-prin1-to-string pn)
         ";value="
         (vl-prin1-to-string (ToString (vlax-get p 'Value) unt))
         ";edit_width=18;allow_accept=true;}"
         ":edit_box{label=\"Fuzz\";key="
         (vl-prin1-to-string (strcat pn "_fuzz"))
         ";value=\"1e-12\";edit_width=6;allow_accept=true;}}"
       )
       file
     )
    )
      )
    )
    (write-line
      (strcat
    "}spacer;:radio_row{key=\"selset\";"
    ":radio_button{label=\"All drawing\";key=\"all\";value=\"1\";}"
    ":radio_button{label=\"Selection\";key=\"sel\";}}"
    "spacer;ok_cancel;}"
      )
      file
    )
    (close file)
    (setq dcl_id (load_dialog tmp))
    (if (not (new_dialog "DynBlkProps" dcl_id))
      (exit)
    )
    (foreach p pop
      (start_list (car p))
      (mapcar 'add_list (cdr p))
      (end_list)
    )
    (action_tile
      "accept"
      "(foreach p (mapcar 'vla-get-PropertyName lst)
      (if (assoc p pop)
      (setq val (nth (atoi (get_tile p)) (cdr (assoc p pop))))
      (setq val (get_tile p)))
      (if (and val (/= val \"\") (/= val \"*\"))
      (setq ret (cons (cons p val) ret))))
      (setq fuzz (mapcar (function (lambda (x)
      (cons x (get_tile (strcat x \"_fuzz\"))))) fuzz))
      (and (not ret) (setq ret T))
      (setq sel (get_tile \"selset\"))
      (done_dialog)"
    )
    (action_tile "cancel" "(setq ret nil)")
    (start_dialog)
    (unload_dialog dcl_id)
    (vl-file-delete tmp)
    ret
  )
 
  ;;----------------------------------------------------;;
 
  (setq dz (getvar 'dimzin))
  (setvar 'dimzin 8)
  (and
    (or
      (and
    (setq ss (cadr (ssgetfirst)))
    (= 1 (sslength ss))
    (setq ent (ssname ss 0))
    (sssetfirst nil nil)
      )
      (and
    (sssetfirst nil nil)
    (setq ent (car (entsel)))
      )
    )
    (setq blk (vlax-ename->vla-object ent))
    (= (vla-get-ObjectName blk) "AcDbBlockReference")
    (= (vla-get-IsDynamicBlock blk) :vlax-true)
    (not (redraw ent 3))
    (setq name (vla-get-EffectiveName blk))
    (or
      (DynBlkPropValue (vlax-invoke blk 'getDynamicBlockProperties))
      (redraw ent 4)
    )
    (not (redraw ent 4))
    (if (= sel "all")
      (ssget "_X"
         (list '(0 . "INSERT") (cons 2 (strcat name ",`*U*")))
      )
      (ssget (list '(0 . "INSERT") (cons 2 (strcat name ",`*U*")))
      )
    )
    (setq res (ssadd))
    (vlax-for b (setq ss (vla-get-ActiveSelectionSet *acdoc*))
      (if
    (and
      (= (vla-get-EffectiveName b) name)
      (or
        (= ret T)
        ((lambda (lst)
           (apply
         '=
         (cons
           T
           (mapcar
             (function
               (lambda (p / n v l u f)
             (setq n (car p)
                   l (assoc n lst)
                   u (vla-get-UnitsType (caddr l))
             )
             (equal (cond
                  ((= 0 u) (cdr p))
                  ((= 1 u) (angtof (cdr p)))
                  (T (distof (cdr p)))
                )
                (if (= u 0)
                  (vl-princ-to-string (cadr l))
                  (cadr l)
                )
                (if (and (setq f (cdr (assoc n fuzz)))
                     (numberp (read f))
                    )
                  (atof f)
                  1e-12
                )
             )
               )
             )
             ret
           )
         )
           )
         )
          (mapcar
        (function
          (lambda (p / n v)
            (list
              (setq n (vla-get-PropertyName p))
              (vlax-get p 'Value)
              p
            )
          )
        )
        (vlax-invoke b 'getDynamicBlockProperties)
          )
        )
      )
    )
     (ssadd (vlax-vla-object->ename b) res)
      )
    )
    (vla-delete ss)
  )
  (setvar 'dimzin dz)
  res
)
 
(defun c:ssd ()
  (sssetfirst nil (ssd))
  (princ)
)