[编程交流] 选择集团的所有实例

(defun c:SB2 ()
(COND (T (SETVAR "CMDECHO" 0)
(SETQ L1 nil)
(WHILE (= L1 nil)
  (SETQ L1(ENTSEL "Pick BLOCK to acquire its instances in the drawing...")))
  (SETQ L1 (ENTGET (CAR L1)) L1 (CDR (ASSOC 2 L1))L1 (SSGET "X" (LIST (CONS 2 L1)))) 
(PRINC)
  )
 )
)

(setq Sel (entsel "\n Select block to select likewise: "))
(setq Obj (vlax-ename->vla-object (car Sel)))
(= (vla-get-ObjectName Obj) "AcDbBlockReference")
(= (vla-get-IsDynamicBlock obj) :vlax-true)
(setq BlkName (vla-get-EffectiveName Obj)); end and

(defun c:getblk    (/ e name n out ss x rjp-getblockname)
 (defun rjp-getblockname (obj)
   (if    (vlax-property-available-p obj 'effectivename)
     (vla-get-effectivename obj)
     (vla-get-name obj)
   )
 )
 (if (setq x     (ssget '((0 . "INSERT")))
       x     (ssname x 0)
       name (rjp-getblockname (vlax-ename->vla-object x))
       ss     (ssget "_X" '((0 . "INSERT")))
       n     -1
       out     (ssadd)
     )
   (while (setq e (ssname ss (setq n (1+ n))))
     (if (= (rjp-getblockname (vlax-ename->vla-object e)) name)
   (ssadd e out)
     )
   )
 )
 (sssetfirst nil out)
 (princ)
)

;;; SSD R2.3 (gile) 14/07/2008
;;; 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 means "all vaue")
(defun ssd (/ DynBlkPropValue ss blk name pop ret fuzz sel res)
 (vl-load-com)
 ;; DynBlkPropValue
 ;; Dialog box to choose dynamic properties values
 ;;
 ;; Argument : the dynamic properties list (vla-object list)
 (defun DynBlkPropValue (lst / tmp file pn 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))
     (cond
((setq av (vlax-get p 'AllowedValues))
 (setq pop
        (cons (cons pn (cons "" (mapcar 'vl-princ-to-string av)))
              pop
        )
 )
 (write-line
   (strcat
     ":popup_list{label="
     (vl-prin1-to-string pn)
     ";key="
     (vl-prin1-to-string pn)
     ";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)
     ";edit_width=12;allow_accept=true;}"
     ":edit_box{label="Fuzz";key="
     (vl-prin1-to-string (strcat pn "_fuzz"))
     ";value="0.0";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 ""))
     (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
 )
 ;;----------------------------------------------------;;
 (and
   (or
     (and
(setq ss (cadr (ssgetfirst)))
(= 1 (sslength ss))
(setq blk (vlax-ename->vla-object (ssname ss 0)))
(sssetfirst nil nil)
     )
     (and
(sssetfirst nil nil)
(setq blk (car (entsel)))
(setq blk (vlax-ename->vla-object blk))
     )
   )
   (= (vla-get-ObjectName blk) "AcDbBlockReference")
   (= (vla-get-IsDynamicBlock blk) :vlax-true)
   (setq name (vla-get-EffectiveName blk))
   (DynBlkPropValue
     (vlax-invoke blk 'getDynamicBlockProperties)
   )
   (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
                   (vla-get-activeDocument
                     (vlax-get-acad-object)
                   )
                 )
        )
     (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)))
                        )
                        (cadr l)
                        (if (and (setq f (cdr (assoc n fuzz)))
                                 (numberp (read f))
                            )
                          (atof f)
                          0.0
                        )
                 )
               )
             )
             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)
 )
 res
)
;;; Calling function
(defun c:ssd ()
 (sssetfirst nil (ssd))
 (princ)
)

; error: no function definition: VLAX-ENAME->VLA-OBJECT