[编程交流] 选择相似的可见性统计

(defun c:demo (/ LM:getvisibilityparametername _curvis curvis e en ess ssvis)
 ;; Get Visibility Parameter Name  -  Lee Mac
 ;; Returns the name of the Visibility Parameter of a Dynamic Block (if present)
 ;; blk - [vla] VLA Dynamic Block Reference object
 ;; Returns: [str] Name of Visibility Parameter, else nil
 (defun LM:getvisibilityparametername (blk / vis)
   (if
     (and
(vlax-property-available-p blk 'effectivename)
(setq blk
       (vla-item
         (vla-get-blocks (vla-get-document blk))
         (vla-get-effectivename blk)
       )
)
(= :vlax-true (vla-get-isdynamicblock blk))
(= :vlax-true (vla-get-hasextensiondictionary blk))
(setq vis
       (vl-some
         '(lambda (pair)
            (if
              (and
                (= 360 (car pair))
                (= "BLOCKVISIBILITYPARAMETER"
                   (cdr (assoc 0 (entget (cdr pair))))
                )
              )
               (cdr pair)
            )
          )
         (dictsearch
           (vlax-vla-object->ename (vla-getextensiondictionary blk))
           "ACAD_ENHANCEDBLOCK"
         )
       )
)
     )
      (cdr (assoc 301 (entget vis)))
   )
 )
 (defun _curvis (_e _vn)
   (vlax-get
     (vl-some '(lambda        (l)
          (if (eq _vn (vla-get-propertyname l))
            l
          )
        )
       (vlax-invoke _e 'GetDynamicBlockProperties)
     )
     'Value
   )
 )
 (if
   (and (setq e (ssget "_:S:E" '((0 . "INSERT"))))
 (setq
   en (vla-item        (vla-get-blocks
                  (vla-get-ActiveDocument (vlax-get-acad-object))
                )
                (setq effname
                       (vla-get-EffectiveName
                         (setq e (vlax-ename->vla-object (ssname e 0)))
                       )
                )
      )
 )
 (minusp (vlax-get en 'IsDynamicBlock))
 (setq visname (LM:getvisibilityparametername e))
 (setq curvis (_curvis e visname))
 (setq ssvis (ssadd)
       ssx   (ssget "X" (list (cons 2 (strcat effname ",`*U*"))))
 )
   )
    (repeat (setq i (sslength ssx))
      (if (and        (eq (vla-get-EffectiveName
              (setq es (vlax-ename->vla-object
                         (setq ess (ssname ssx (setq i (1- i))))
                       )
              )
            )
            effname
        )
        (eq (_curvis es visname) curvis)
   )
 (ssadd ess ssvis)
      )
    )
 )
 (if curvis
   (sssetfirst nil ssvis)
 )
 (princ)
)