flopo Posted November 15, 2010 Share Posted November 15, 2010 (edited) Hello everybody, I want to this lisp for inserting blocks, but i want to use it in other way - i want to make my icon in my toolbar, and your lisp works together with a dcl. I don't need this dcl, i want to make a macro ... can you help me please? This is the routine that i'm talking about... Thanks! ;;----------------------=={ Copy Block }==--------------------;; ;; ;; ;; Copies the specified block definition from the specified ;; ;; filename to the ActiveDocument using a deep clone ;; ;; operation (Method inspired by Tony Tanzillo) ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; block - string specifying block name to copy ;; ;; filename - filename of drawing from which to copy block ;; ;;------------------------------------------------------------;; ;; Returns: Block definition in ActiveDocument, else nil ;; ;;------------------------------------------------------------;; (defun LM:CopyBlock ( block filename / acapp acdoc acblk acdocs dbxDoc item ) (vl-load-com) ;; © Lee Mac 2010 (setq acapp (vlax-get-acad-object) acdoc (vla-get-ActiveDocument acapp) acblk (vla-get-Blocks acdoc)) (vlax-map-collection (vla-get-Documents acapp) (function (lambda ( doc ) (setq acdocs (cons (cons (strcase (vla-get-fullname doc)) doc) acdocs ) ) ) ) ) (if (and (not (LM:Itemp acblk block)) (setq filename (findfile filename)) (not (eq filename (vla-get-fullname acdoc))) (or (setq dbxDoc (cdr (assoc (strcase filename) acdocs))) (progn (setq dbxDoc (LM:ObjectDBXDocument)) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbxDoc filename)) ) ) ) ) (setq item (LM:Itemp (vla-get-Blocks dbxDoc) block)) ) (vla-CopyObjects dbxDoc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbObject '(0 . 0)) (list item) ) ) acblk ) ) (and dbxDoc (vlax-release-object dbxDoc)) (LM:Itemp acblk block) ) ;;-----------------=={ ObjectDBX Document }==-----------------;; ;; ;; ;; Retrieves a version specific ObjectDBX Document object ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: - None - ;; ;;------------------------------------------------------------;; ;; Returns: VLA ObjectDBX Document object, else nil ;; ;;------------------------------------------------------------;; (defun LM:ObjectDBXDocument ( / acVer ) ;; © Lee Mac 2010 (vla-GetInterfaceObject (vlax-get-acad-object) (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa acVer)) ) ) ) ;;-----------------------=={ Itemp }==------------------------;; ;; ;; ;; Retrieves the item with index 'item' if present in the ;; ;; specified collection, else nil ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; coll - the VLA Collection Object ;; ;; item - the index of the item to be retrieved ;; ;;------------------------------------------------------------;; ;; Returns: the VLA Object at the specified index, else nil ;; ;;------------------------------------------------------------;; (defun LM:Itemp ( coll item ) ;; © Lee Mac 2010 (if (not (vl-catch-all-error-p (setq item (vl-catch-all-apply (function vla-item) (list coll item) ) ) ) ) item ) ) ;; Test Function (defun c:instbl ( / *error* doc blk dwg pt norm ) (vl-load-com) ;; © Lee Mac 2010 (defun *error* ( msg ) (and dbxDoc (vlax-release-object dbxDoc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (if (and (setq blk (getstring t "\nSpecify Name of Block to Copy: ")) (setq dwg (getfiled "Select Drawing to Copy From" "" "dwg" 16)) (LM:CopyBlock blk dwg) (setq pt (getpoint "\nPick Point for Block: ")) ) (progn (setq norm (trans '(0. 0. 1.) 1 0 t)) (vla-insertBlock (if (or (eq AcModelSpace (vla-get-ActiveSpace (setq doc (vla-get-ActiveDocument (vlax-get-acad-object) ) ) ) ) (eq :vlax-true (vla-get-MSpace doc)) ) (vla-get-ModelSpace doc) (vla-get-PaperSpace doc) ) (vlax-3D-point (trans pt 1 0)) blk 1. 1. 1. (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 norm t)) ) ) ) (princ) ) insblk2.lsp insblk2.dcl Edited November 15, 2010 by Tiger added code-tags Quote Link to comment Share on other sites More sharing options...
Guest kruuger Posted November 15, 2010 Share Posted November 15, 2010 tool palette is good for that (no lisp required) ? kruuger Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted November 15, 2010 Share Posted November 15, 2010 (edited) Hi Flopo, I'm in the middle of updating that code for my site, it should be on there soon. EDIT: Here: http://lee-mac.com/copyblockfromdrawing.html -- although this version does use a dialog. In the meantime, you can call the code using macro hence: ^C^C(LM:CopyBlock "BlockName" "C:\\MyDrawing.dwg") Edited November 15, 2010 by Lee Mac 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.