select blocks by name and rotation angle

Greetings everyone ,

i have this lisp which select blocks by rotation angle but it select all blocks instances that have the same rotation angles i need to filter the result to select only the selected block instances .. any help will be appreciated ... thanks in advance

(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)
 )

Its a good manner to mention the author's name.

Its a good manner to mention the author's name.

yes it's good manner if you know the author name ... but i don't know it as i have 250 lisp files that i used from few years ago and i don't know where i found them ...

Its a good manner to mention the author's name.

It's OK Grrr. It's my mistake, I don't sign all my lisp.

@handasa:

I guess you are using a different lisp that select all the blocks by rotation. The lisp you posted is selecting blocks by name. This is how to modify it to filter blocks by rotation.

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

This is mind-boggling:

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

It's OK Grrr. It's my mistake, I don't sign all my lisp.

Thats a nice code, Stefan! Thats why I thought the author deserve some appreciation.

This is mind-boggling:

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

Didn't saw it. I've made the changes and test in the original code.

Some alternative:

(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)

Doesn't support multiple source block references, although.

@Grrr

@Stefan BMR

many thanks to both of you and your valuable contributions ... both of your suggestions work perfectly

thanks again

It's OK Grrr. It's my mistake, I don't sign all my lisp.

 

@handasa:

I guess you are using a different lisp that select all the blocks by rotation. The lisp you posted is selecting blocks by name. This is how to modify it to filter blocks by rotation.

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

it was your original lisp but i made a little unprofessional modification to it to select blocks by rotation ... it's now works properly after your last edit ... thanks again

how to remove select bylayer from the lisp

how to remove select bylayer from the lisp

In the same place, remove 6 and 62 from both lists.

In this case, the line could be more simple:

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

In the same place, remove 6 and 62 from both lists.

In this case, the line could be more simple:

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

i changed the line in ssb and ssr lisp to the above line and it still select blocks filtered by the original block layer

Ok. Please clarify what are the requirements, concise and complete.

Ok. Please clarify what are the requirements, concise and complete.

1- lisp to select blocks by name and rotation angle neglecting layer

1- lisp to select blocks by name only neglecting layer and other properties

thanks for your patience and your help

SSR is for block name and rotation and SSB is just for the block name.

(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)
 )

@Stefan BMR

worked perfectly ... thanks sir very much