Jump to content

insert-block from other drawing


flopo

Recommended Posts

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 by Tiger
added code-tags
Link to comment
Share on other sites

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 by Lee Mac
Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...