handasa Posted November 2, 2016 Share Posted November 2, 2016 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) ) Quote Link to comment Share on other sites More sharing options...
Grrr Posted November 2, 2016 Share Posted November 2, 2016 Its a good manner to mention the author's name. Quote Link to comment Share on other sites More sharing options...
handasa Posted November 2, 2016 Author Share Posted November 2, 2016 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 ... Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted November 2, 2016 Share Posted November 2, 2016 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))) Quote Link to comment Share on other sites More sharing options...
Roy_043 Posted November 2, 2016 Share Posted November 2, 2016 This is mind-boggling: (if (vlax-property-available-p o 'EffectiveName) 'rotation 'EffectiveName) Quote Link to comment Share on other sites More sharing options...
Grrr Posted November 2, 2016 Share Posted November 2, 2016 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. Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted November 2, 2016 Share Posted November 2, 2016 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. Quote Link to comment Share on other sites More sharing options...
Grrr Posted November 2, 2016 Share Posted November 2, 2016 (edited) 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. Edited November 2, 2016 by Grrr Quote Link to comment Share on other sites More sharing options...
handasa Posted November 3, 2016 Author Share Posted November 3, 2016 @Grrr @Stefan BMR many thanks to both of you and your valuable contributions ... both of your suggestions work perfectly thanks again Quote Link to comment Share on other sites More sharing options...
handasa Posted November 3, 2016 Author Share Posted November 3, 2016 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 Quote Link to comment Share on other sites More sharing options...
handasa Posted November 3, 2016 Author Share Posted November 3, 2016 how to remove select bylayer from the lisp Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted November 3, 2016 Share Posted November 3, 2016 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)) Quote Link to comment Share on other sites More sharing options...
handasa Posted November 3, 2016 Author Share Posted November 3, 2016 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 Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted November 3, 2016 Share Posted November 3, 2016 Ok. Please clarify what are the requirements, concise and complete. Quote Link to comment Share on other sites More sharing options...
handasa Posted November 3, 2016 Author Share Posted November 3, 2016 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 Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted November 3, 2016 Share Posted November 3, 2016 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) ) Quote Link to comment Share on other sites More sharing options...
handasa Posted November 3, 2016 Author Share Posted November 3, 2016 @Stefan BMR worked perfectly ... thanks sir very much Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.