[编程交流] 按名称和rota选择块

(mapcar '(lambda (a) (assoc a e)) '(0 8 50))

(defun C:SSR ( / s1 i e l f o n s2)
 (princ "\nSelect source object(s):")
 (if
   (if
     (setq s1 (ssget "I" '((0 . "INSERT"))))
     (progn (sssetfirst nil nil) s1)
     (setq s1 (ssget '((0 . "INSERT"))))
   )
   (progn
     (repeat (setq i (sslength s1))
       (setq i (1- i)
             o (vlax-ename->vla-object (ssname s1 i))
             e (entget (ssname s1 i))
             l (mapcar '(lambda (a) (assoc a e)) '(0 50))
             n (cons (vlax-get o (if (vlax-property-available-p o 'EffectiveName) 'EffectiveName 'Name)) n)
             )
       (if (not (member l f)) (setq f (cons l f)))
       )
     (setq f (mapcar '(lambda (a) (append '((-4 . "<AND")) a '((-4 . "AND>")))) f))
     (setq f (append '((-4 . "<OR")) (apply 'append f) '((-4 . "OR>"))))
     (princ "\n\nSelect area for similar blocks...")
     (if (setq s2 (ssget f))
       (repeat (setq i (sslength s2))
         (if
           (not (member (vlax-get (setq o (vlax-ename->vla-object (setq e (ssname s2 (setq i (1- i)))))) (if (vlax-property-available-p o 'EffectiveName) 'EffectiveName 'Name)) n))
           (ssdel e s2)
           )
         )
       )
     (if s2 (princ (strcat (itoa (sslength s2)) " objects")))
     (sssetfirst nil s2)
     )
   )
 (if (zerop (getvar 'cmdactive)) (princ) s2)
 )
(defun C:SSB ( / s1 i e l o n s2)
 (princ "\nSelect source object(s):")
 (if
   (if
     (setq s1 (ssget "I" '((0 . "INSERT"))))
     (progn (sssetfirst nil nil) s1)
     (setq s1 (ssget '((0 . "INSERT"))))
   )
   (progn
     (repeat (setq i (sslength s1))
       (setq o (vlax-ename->vla-object (ssname s1 (setq i (1- i))))
             n (vlax-get o (if (vlax-property-available-p o 'EffectiveName) 'EffectiveName 'Name))
       )
       (if (not (member n l)) (setq l (cons n l)))
     )
     (princ "\n\nSelect area for similar blocks...")
     (if (setq s2 (ssget '((0 . "INSERT"))))
       (repeat (setq i (sslength s2))
         (if
           (not
             (member
               (vlax-get
                 (setq o
                   (vlax-ename->vla-object
                     (setq e (ssname s2 (setq i (1- i))))
                   )
                 )
                 (if (vlax-property-available-p o 'EffectiveName)
                   'EffectiveName
                   'Name
                 )
               )
               l
             )
           )
           (ssdel e s2)
           )
         )
       )
     (if s2 (princ (strcat (itoa (sslength s2)) " objects")))
     (sssetfirst nil s2)
     )
   )
 (if (zerop (getvar 'cmdactive)) (princ) s2)
 )