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

(defun C:SSR ( / s1 i e l f o n s2)
 (princ "\nSelect source object:")
 (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 b) (cond ((assoc a e)) (b))) '(0 8 6 62) '(0 0 (6 . "ByLayer") (62 . 256)))
             n (cons (vlax-get o (if (vlax-property-available-p o 'EffectiveName) 'rotation 'EffectiveName)) 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) 'rotation 'EffectiveName)) n))
           (ssdel e s2)
           )
         )
       )
     (if s2 (princ (strcat (itoa (sslength s2)) " objects")))
     (sssetfirst nil s2)
     )
   )
 (if (zerop (getvar 'cmdactive)) (princ) s2)
 )

'(0 8 6 [color=red][b]50[/b][/color] 62) '(0 0 (6 . "ByLayer") [b][color=red](50 . 0.0)[/color][/b] (62 . 256)))

(if (vlax-property-available-p o 'EffectiveName) 'rotation 'EffectiveName)

(defun C:test ; Written by: Grrr, credits to: Lee Mac, Tharwat
( / PropsLst SS sBe sBo srcLst i dBe dBo dstLst )
(setq PropsLst (list 'EffectiveName 'Layer 'Linetype 'Rotation 'TrueColor)) ; <- list of required properties
(and (setq SS (ssget "_I" (list (cons 0 "INSERT")))) (sssetfirst nil nil))
(setvar 'errno 0)
(while (/= 52 (getvar 'errno))
        (setq sBe (car (entsel "\nSelect source block:" )))
        (cond
                ( (and sBe (eq (vla-get-ObjectName (setq sBo (vlax-ename->vla-object sBe))) "AcDbBlockReference"))
                        (setq srcLst 
                                (mapcar 
                                        (function
                                                (lambda (x) 
                                                        (if (not (eq x 'TrueColor)) 
                                                                (vlax-get sBo x)
                                                                (mapcar 
                                                                        (function
                                                                                (lambda (p)
                                                                                        (vlax-get (vlax-get sBo 'TrueColor) p)
                                                                                )
                                                                        )
                                                                        (list 'ColorIndex 'Red 'Green 'Blue)
                                                                )
                                                        ); if
                                                ) 
                                        )
                                        PropsLst
                                )
                        )
                        (setvar 'errno 52)
                )
                ( T nil )
        )
)
(if 
        (and
                sBe
                (or SS
                        (and 
                                (princ "\nSelect blocks to be filtered: ") 
                                (setq SS 
                                        (ssget 
                                                (vl-remove nil
                                                        (list 
                                                                (cons 0 "INSERT")
                                                                (if (member 'EffectiveName PropsLst) (cons 2 (strcat "`*U*," (vla-get-EffectiveName sBo))))
                                                        )
                                                )
                                        )
                                )
                        )
                )
        )
        (repeat (setq i (sslength SS))
                (setq dBo (vlax-ename->vla-object (setq dBe (ssname SS (setq i (1- i))))))
                (setq dstLst 
                        (mapcar 
                                (function
                                        (lambda (x) 
                                                (if (not (eq x 'TrueColor))
                                                        (vlax-get dBo x)
                                                        (mapcar 
                                                                (function
                                                                        (lambda (p)
                                                                                (vlax-get (vlax-get dBo 'TrueColor) p)
                                                                        )
                                                                )
                                                                (list 'ColorIndex 'Red 'Green 'Blue)
                                                                )
                                                        ); if
                                                ) 
                                )
                                PropsLst
                        )
                )
                (and (not (equal srcLst dstLst)) (ssdel dBe SS))
        )
)
(sssetfirst nil SS)
(princ)
);| defun |; (or vlax-get-acad-object (vl-load-com)) (princ)