Thanks Lee for this:
It was a good starting point for me to pick a block in the drawing and then use that as the replace.
My edit below:
- (defun c:BK_Replace_With_Object ( / *error* _StartUndo _EndUndo doc spc ss ll ur )(vl-load-com) ;; Lee Mac 2010 - www.lee-mac.com (defun *error* ( msg ) (if doc (_EndUndo doc)) (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) ) ) (LM:ActiveSpace 'doc 'spc) (if (and ; Old Code by LeeMac ; (setq *dwg (getfiled "Select Block" (vl-filename-directory (cond ( *dwg ) ( "" ))) "dwg" 16)) ; EDIT by 3dwannab 15-03-18 (cond ( (and (setq *dwg (car (entsel "\nSelect Block Entity: "))) (eq (cdr (assoc 0 (entget *dwg))) "INSERT") (setq *dwg (vla-get-effectivename (vlax-ename->vla-object *dwg))) ) ) ) ;; End EDIT (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons 410 (getvar 'CTAB)))) ) (progn (_StartUndo doc) (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc)) (vla-getBoundingBox obj 'll 'ur) ( (lambda ( block ) (mapcar (function (lambda ( p ) (vlax-put-property block p (vlax-get-property obj p)) ) ) '(Layer Linetype Lineweight) ) ( (lambda ( hyp ) (vlax-for h (vla-get-HyperLinks obj) (vla-Add hyp (vla-get-Url h) (vla-get-UrlDescription h) (vla-get-UrlNamedLocation h)) ) ) (vla-get-HyperLinks block) ) ) (vla-InsertBlock spc (vlax-3D-point (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.)) (mapcar 'vlax-safearray->list (list ll ur)) ) ) ) *dwg 1. 1. 1. 0. ) ) (vla-delete obj) ) (vla-delete ss) (_EndUndo doc) ) ) (princ) );;--------------------=={ ActiveSpace }==---------------------;;;; ;;;; Retrieves pointers to the Active Document and Space ;;;;------------------------------------------------------------;;;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;;;;------------------------------------------------------------;;;; Arguments: ;;;; *doc - quoted symbol (other than *doc) ;;;; *spc - quoted symbol (other than *spc) ;;;;------------------------------------------------------------;;(defun LM:ActiveSpace ( *doc *spc ) ;; © Lee Mac 2010 (set *spc (vlax-get-property (set *doc (vla-get-ActiveDocument (vlax-get-acad-object) ) ) (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace) ) ) )(princ(strcat "\n##############################################################" "\n_____________ Loaded 'BK_Replace_With_Object.lsp'_____________" "\n____________ Type 'BK_Replace_With_Object' to run_____________" "\n##############################################################" ))(princ)
|