BrianTFC 11 Posted February 16, 2018 All, I've been using Lee Mac's "Add object to block" lisp for sometime now and it works great, and one of the things I use it for is my title block for revisions but now the revision block has been inserted into the title block as a block and it won't add what I want to the revision block. Is there a way to make it find the revision block inside of the title block? Basically I would to able to pick the block inside of a block. ;;----------------=={ Add Objects to Block }==----------------;; ;; ;; ;; Adds all objects in the provided SelectionSet to the ;; ;; definition of the specified block. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; doc - Document Object in which block resides. ;; ;; block - Entity name of reference insert ;; ;; ss - SelectionSet of objects to add to definition ;; ;;------------------------------------------------------------;; (defun LM:AddObjectstoBlock ( doc block ss / lst mat ) (setq lst (LM:ss->vla ss) mat (LM:Ref->Def block) mat (vlax-tmatrix (append (mapcar 'append (car mat) (mapcar 'list (cadr mat))) '((0. 0. 0. 1.)))) ) (foreach obj lst (vla-transformby obj mat)) (vla-CopyObjects doc (LM:SafearrayVariant vlax-vbobject lst) (vla-item (vla-get-Blocks doc) (cdr (assoc 2 (entget block)))) ) (foreach obj lst (vla-delete obj)) (vla-regen doc acAllViewports) ) ;;-----------------=={ Remove From Block }==------------------;; ;; ;; ;; Removes an Entity from a Block Definition ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; ent - Entity name of Object to Delete from Block [ENAME] ;; ;;------------------------------------------------------------;; (defun LM:RemovefromBlock ( doc ent ) (vla-delete (vlax-ename->vla-object ent)) (vla-regen doc acAllViewports) (princ) ) ;;------------------=={ Safearray Variant }==-----------------;; ;; ;; ;; Creates a populated Safearray Variant of a specified ;; ;; data type ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; datatype - variant type enum (eg vlax-vbDouble) ;; ;; data - list of static type data ;; ;;------------------------------------------------------------;; ;; Returns: VLA Variant Object of type specified ;; ;;------------------------------------------------------------;; (defun LM:SafearrayVariant ( datatype data ) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray datatype (cons 0 (1- (length data)))) data ) ) ) ;;------------=={ SelectionSet -> VLA Objects }==-------------;; ;; ;; ;; Converts a SelectionSet to a list of VLA Objects ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; ss - Valid SelectionSet (Pickset) ;; ;;------------------------------------------------------------;; ;; Returns: List of VLA Objects, else nil ;; ;;------------------------------------------------------------;; (defun LM:ss->vla ( ss / i l ) (if ss (repeat (setq i (sslength ss)) (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l)) ) ) ) ;;---------------=={ Block Ref -> Block Def }==---------------;; ;; ;; ;; Returns the Transformation Matrix and Translation Vector ;; ;; for transforming Block Reference Geometry to the Block ;; ;; Definiton. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; e - Block Reference Entity ;; ;;------------------------------------------------------------;; ;; Returns: List of 3x3 Transformation Matrix, Vector ;; ;;------------------------------------------------------------;; (defun LM:Ref->Def ( e / _dxf a l n ) (defun _dxf ( x l ) (cdr (assoc x l))) (setq l (entget e) a (- (_dxf 50 l)) n (_dxf 210 l)) ( (lambda ( m ) (list m (mapcar '- (_dxf 10 (tblsearch "BLOCK" (_dxf 2 l))) (mxv m (trans (_dxf 10 l) n 0) ) ) ) ) (mxm (list (list (/ 1. (_dxf 41 l)) 0. 0.) (list 0. (/ 1. (_dxf 42 l)) 0.) (list 0. 0. (/ 1. (_dxf 43 l))) ) (mxm (list (list (cos a) (sin (- a)) 0.) (list (sin a) (cos a) 0.) (list 0. 0. 1.) ) (mapcar '(lambda ( e ) (trans e n 0 t)) '( (1. 0. 0.) (0. 1. 0.) (0. 0. 1.) ) ) ) ) ) ) ;; Matrix x Vector - Vladimir Nesterovsky (defun mxv ( m v ) (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) ) ;; Matrix x Matrix - Vladimir Nesterovsky (defun mxm ( m q ) (mapcar (function (lambda ( r ) (mxv (trp q) r))) m) ) ;; Matrix Transpose - Doug Wilson (defun trp ( m ) (apply 'mapcar (cons 'list m)) ) ;;---------------------=={ Select if }==----------------------;; ;; ;; ;; Provides continuous selection prompts until either a ;; ;; predicate function is validated or a keyword is supplied. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; msg - prompt string ;; ;; pred - optional predicate function [selection list arg] ;; ;; func - selection function to invoke ;; ;; keyw - optional initget argument list ;; ;;------------------------------------------------------------;; ;; Returns: Entity selection list, keyword, or nil ;; ;;------------------------------------------------------------;; (defun LM:SelectIf ( msg pred func keyw / sel ) (setq pred (eval pred)) (while (progn (setvar 'ERRNO 0) (if keyw (apply 'initget keyw)) (setq sel (func msg)) (cond ( (= 7 (getvar 'ERRNO)) (princ "\nMissed, Try again.") ) ( (eq 'STR (type sel)) nil ) ( (vl-consp sel) (if (and pred (not (pred sel))) (princ "\nInvalid Object Selected.") ) ) ) ) ) sel ) ;-------------------------------------------------------------; ; -- Test Functions -- ; ;-------------------------------------------------------------; (defun c:Add2Block ( / *error* _StartUndo _EndUndo acdoc ss e ) (defun *error* ( msg ) (if acdoc (_EndUndo acdoc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (defun _StartUndo ( doc ) (_EndUndo doc) (vla-StartUndoMark doc) ) (defun _EndUndo ( doc ) (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndoMark doc) ) ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (if (and (setq ss (ssget "_:L")) (setq e (LM:SelectIf "\nSelect Block to Add Objects to: " '(lambda ( x ) (eq "INSERT" (cdr (assoc 0 (entget (car x)))))) entsel nil ) ) ) (progn (_StartUndo acdoc) (LM:AddObjectstoBlock acdoc (car e) ss) (_EndUndo acdoc) ) ) (princ) ) ;-------------------------------------------------------------; (defun c:Remove ( / *error* _StartUndo _EndUndo acdoc e ) (defun *error* ( msg ) (if acdoc (_EndUndo acdoc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (defun _StartUndo ( doc ) (_EndUndo doc) (vla-StartUndoMark doc) ) (defun _EndUndo ( doc ) (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndoMark doc) ) ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (while (setq e (car (nentsel "\nSelect Object to Remove: "))) (_StartUndo acdoc) (LM:RemovefromBlock acdoc e) (_EndUndo acdoc) ) (princ) ) (vl-load-com) (princ) ;;------------------------------------------------------------;; ;; End of File ;; ;;------------------------------------------------------------;; Quote Share this post Link to post Share on other sites