;;Select blocks by name and rotation angle
;; Stefan BMR Programm
(defun C:SBR ( / 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 50 62) '(0 0 (6 . "ByLayer") (50 . 0.0) (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 . "")))) f))
(setq f (append '((-4 . ""))))
(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)
)
(c:sbr)

Advertisements