+ Reply to Thread
Results 1 to 3 of 3
  1. #1
    Senior Member
    Using
    Map 3D 2008
    Join Date
    Sep 2009
    Posts
    114

    Default insert-block from other drawing

    Registered forum members do not see this ad.

    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!





    Code:
    ;;----------------------=={ 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)
    )
    Attached Files
    Last edited by Tiger; 15th Nov 2010 at 10:08 am. Reason: added code-tags

  2. #2
    Senior Member kruuger's Avatar
    Computer Details
    kruuger's Computer Details
    Operating System:
    Xp 64bit
    Using
    AutoCAD 2010
    Join Date
    Dec 2007
    Location
    Poland
    Posts
    193

    Default

    tool palette is good for that (no lisp required) ?
    kruuger

  3. #3
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    16,811

    Default

    Registered forum members do not see this ad.

    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:

    Code:
    ^C^C(LM:CopyBlock "BlockName" "C:\\MyDrawing.dwg")
    Last edited by Lee Mac; 15th Nov 2010 at 06:31 pm.
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

Similar Threads

  1. Insert a block by lisp: _.insert or another way?
    By MarcoW in forum AutoLISP, Visual LISP & DCL
    Replies: 11
    Last Post: 3rd Nov 2010, 10:40 am
  2. Insert block, add circle, exlode, create block
    By rookie37 in forum AutoLISP, Visual LISP & DCL
    Replies: 7
    Last Post: 29th Jun 2010, 10:40 pm
  3. Insert Block from within Drawing - VBA
    By hairyuga in forum AutoLISP, Visual LISP & DCL
    Replies: 16
    Last Post: 28th Feb 2009, 05:45 pm
  4. Insert Block when open new drawing
    By matthewrussell in forum AutoLISP, Visual LISP & DCL
    Replies: 5
    Last Post: 12th Dec 2008, 12:44 pm
  5. Insert a 3D drawing into a 2d title block using SOLPROF
    By mfranke in forum AutoCAD General
    Replies: 4
    Last Post: 7th Jan 2008, 09:01 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts