Grab block from one drawing and insert into another via a lisp

[Mark_ATCW]

Hi All,

Not sure if this is possible but I'm looking for a way to grab a block that is a block in one drawing and insert it into another drawing via a lisp function

The scenario is that i have a drawing that is a "master" drawing. It has all of our blocks, line types etc. in it. so I want a way that will only grab the block i want and insert into my active drawing.

Thanks
Mark

[iconeo]

Don't want to use tool pallettes? That is essentially what they do in an easy to use graphical format.

This is possible to do in a myriad of ways though.

Thanks.

Sent from my Pixel 2 XL using Tapatalk

[Dadgad]

Sounds like Lee Mac has got you covered, as usual,

http://www.lee-mac.com/steal.html

Thanks Lee!

I have never used this one, but I believe it will do exactly what you are describing.

[iconeo]

Steal is a great program. I use it extensively in my setup.

Sent from my Pixel 2 XL using Tapatalk

[Mark_ATCW]

Thanks guys,

Yes i do use "steal" a fair bit, but i can get it to go straight to the "Master" drawing it only goes to the folder containing the "master" drawing.

I have on occasion the tool pallettes but when you have about 100 block, it takes it's to much time to read all the block etc. every time you open a drawing....too clunky!!

I'm still looking for one that will just extract a certain commonly used block so that i can have a short cut insert command for it.

Thanks Again,

MC

[Dadgad]

It looks like there are some available options, like StealLast , which could directly access the MASTER dwg, as opposed to accessing the folder.
Also SubFunctions described might be useful. Take a good look at the description Lee wrote for the various ways to use the lisp. In one of those you merely specify the drawing name in the code, if that is always where you want to access your blocks.

It looks like the direct entry Search box might save you a little time, compared to looking through all the blocks, at the bottom of the dialog box..

[rlx]

;;--------------=={ Copy Block From Drawing }==---------------;;
;;                                                            ;;
;;  Copies the selected block definition from the selected    ;;
;;  drawing to the ActiveDocument using a deep clone          ;;
;;  operation.                                                ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - www.lee-mac.com             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
(defun c:cb (/     *error*   acapp  acdoc acblk  spc    dwg
      dbxDoc lst    dcfname  file dc     ptr    fl
      pt     norm   block
     )
  (vl-load-com)
  ;; © Lee Mac 2010
  (defun *error* (msg)
    (vl-catch-all-apply
      '(lambda nil
  (if dbxDoc
    (vlax-release-object dbxDoc)
  )
  (if (and file (eq 'FILE (type file)))
    (setq file (close file))
  )
  (if (and dcfname (setq dcfname (findfile dcfname)))
    (vl-file-delete dcfname)
  )
  (if dc
    (unload_dialog dc)
  )
       )
    )
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
 (princ (strcat "\n** Error: " msg " **"))
    )
    (princ)
  )
  (setq acapp (vlax-get-acad-object)
 acdoc (vla-get-ActiveDocument acapp)
 acblk (vla-get-Blocks acdoc)
  )
  (setq spc
  (if
    (or (eq AcModelSpace (vla-get-ActiveSpace acdoc))
        (eq :vlax-true (vla-get-MSpace acdoc))
    )
     (vla-get-ModelSpace acdoc)
     (vla-get-PaperSpace acdoc)
  )
  )
  (cond
    (
     (not
       (setq dwg (getfiled "Select Drawing to Copy From" "" "dwg" 16))
     )
     (princ "\n*Cancel*")
    )
    (
     (eq dwg (vla-get-fullname acdoc))
     (princ "\n** Cannot Copy from Active Drawing **")
    )
    (
     (not (setq dbxDoc (LM:GetDocumentObject dwg)))
     (princ "\n** Unable to Interface with Selected Drawing **")
    )
    (
     (not
       (progn
  (vlax-for b (vla-get-Blocks dbxDoc)
    (if (not (or (eq :vlax-true (vla-get-isXRef b))
   (eq :vlax-true (vla-get-isLayout b))
      )
        )
      (setq lst (cons (vla-get-name b) lst))
    )
  )
  (setq lst
  (acad_strlsort
    (vl-remove-if '(lambda (x) (tblsearch "BLOCK" x)) lst)
  )
  )
       )
     )
     (princ
       "\n** No distinct Blocks Found in Selected Drawing **"
     )
    )
    (
     (not
       (progn
  (setq dcfname (vl-filename-mktemp nil nil ".dcl"))
  (if (setq file (open dcfname "w"))
    (progn
      (write-line
        "copyblock : dialog { label = \"Select Block to Copy...\"; spacer; : list_box { key = \"blocks\"; } spacer; ok_cancel;}"
        file
      )
      (not (setq file (close file)))
    )
  )
       )
     )
     (princ "\n** Unable to Write DCL File **")
    )
    (
     (<= (setq dc (load_dialog dcfname)) 0)
     (princ "\n** DCL File not Found **")
    )
    (
     (not (new_dialog "copyblock" dc))
     (princ "\n** Unable to Load Dialog **")
    )
    (t
     (start_list "blocks")
     (mapcar 'add_list lst)
     (end_list)
     (setq ptr (set_tile "blocks" "0"))
     (action_tile "blocks" "(setq ptr $value)")
     (setq fl (start_dialog)
    dc (unload_dialog dc)
     )
     (if (and (= 1 fl)
       (setq pt (getpoint "\nSpecify Point for Block: "))
  )
       (progn
  (vla-CopyObjects
    dbxDoc
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbObject '(0 . 0))
        (list (LM:Itemp (vla-get-blocks dbxDoc)
          (setq block (nth (atoi ptr) lst))
       )
        )
      )
    )
    acblk
  )
  (setq norm (trans '(0. 0. 1.) 1 0 t))
  (if (LM:Itemp acblk block)
    (vla-insertBlock
      spc
      (vlax-3D-point (trans pt 1 0))
      block
      1.
      1.
      1.
      (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 norm t))
    )
  )
       )
       (princ "\n*Cancel*")
     )
    )
  )
  (if (and dcfname (setq dcfname (findfile dcfname)))
    (vl-file-delete dcfname)
  )
  (if dbxDoc
    (vlax-release-object dbxDoc)
  )
  (princ)
)
;;-----------------=={ Get Document Object }==----------------;;
;;                                                            ;;
;;  Retrieves a the VLA Document Object for the specified     ;;
;;  filename. Document Object may be present in the Documents ;;
;;  collection, or obtained through ObjectDBX                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - www.lee-mac.com             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  filename - filename for which to retrieve document object ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Document Object, else nil                   ;;
;;------------------------------------------------------------;;
(defun LM:GetDocumentObject (filename / acdocs dbx)
  (vl-load-com)
  ;; © Lee Mac 2010
  (vlax-map-collection
    (vla-get-Documents (vlax-get-acad-object))
    (function
      (lambda (doc)
 (setq acdocs
        (cons
   (cons (strcase (vla-get-fullname doc)) doc)
   acdocs
        )
 )
      )
    )
  )
  (cond
    ((not (setq filename (findfile filename))) nil)
    ((cdr (assoc (strcase filename) acdocs)))
    ((not
       (vl-catch-all-error-p
  (vl-catch-all-apply
    'vla-open
    (list (setq dbx (LM:ObjectDBXDocument)) filename)
  )
       )
     )
     dbx
    )
  )
)
;;-----------------=={ ObjectDBX Document }==-----------------;;
;;                                                            ;;
;;  Retrieves a version specific ObjectDBX Document object    ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - www.lee-mac.com             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  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 - www.lee-mac.com             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  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
  )
)

[Mark_ATCW]

OOh!!! Thanks rlx, let me have a look at this one, looks like a lot in it!! probably wont need all ah!?!?

;;--------------=={ Copy Block From Drawing }==---------------;;
;;                                                            ;;
;;  Copies the selected block definition from the selected    ;;
;;  drawing to the ActiveDocument using a deep clone          ;;
;;  operation.                                                ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - www.lee-mac.com             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
(defun c:cb (/     *error*   acapp  acdoc acblk  spc    dwg
      dbxDoc lst    dcfname  file dc     ptr    fl
      pt     norm   block
     )
  (vl-load-com)
  ;; © Lee Mac 2010
  (defun *error* (msg)
    (vl-catch-all-apply
      '(lambda nil
  (if dbxDoc
    (vlax-release-object dbxDoc)
  )
  (if (and file (eq 'FILE (type file)))
    (setq file (close file))
  )
  (if (and dcfname (setq dcfname (findfile dcfname)))
    (vl-file-delete dcfname)
  )
  (if dc
    (unload_dialog dc)
  )
       )
    )
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
 (princ (strcat "\n** Error: " msg " **"))
    )
    (princ)
  )
  (setq acapp (vlax-get-acad-object)
 acdoc (vla-get-ActiveDocument acapp)
 acblk (vla-get-Blocks acdoc)
  )
  (setq spc
  (if
    (or (eq AcModelSpace (vla-get-ActiveSpace acdoc))
        (eq :vlax-true (vla-get-MSpace acdoc))
    )
     (vla-get-ModelSpace acdoc)
     (vla-get-PaperSpace acdoc)
  )
  )
  (cond
    (
     (not
       (setq dwg (getfiled "Select Drawing to Copy From" "" "dwg" 16))
     )
     (princ "\n*Cancel*")
    )
    (
     (eq dwg (vla-get-fullname acdoc))
     (princ "\n** Cannot Copy from Active Drawing **")
    )
    (
     (not (setq dbxDoc (LM:GetDocumentObject dwg)))
     (princ "\n** Unable to Interface with Selected Drawing **")
    )
    (
     (not
       (progn
  (vlax-for b (vla-get-Blocks dbxDoc)
    (if (not (or (eq :vlax-true (vla-get-isXRef b))
   (eq :vlax-true (vla-get-isLayout b))
      )
        )
      (setq lst (cons (vla-get-name b) lst))
    )
  )
  (setq lst
  (acad_strlsort
    (vl-remove-if '(lambda (x) (tblsearch "BLOCK" x)) lst)
  )
  )
       )
     )
     (princ
       "\n** No distinct Blocks Found in Selected Drawing **"
     )
    )
    (
     (not
       (progn
  (setq dcfname (vl-filename-mktemp nil nil ".dcl"))
  (if (setq file (open dcfname "w"))
    (progn
      (write-line
        "copyblock : dialog { label = \"Select Block to Copy...\"; spacer; : list_box { key = \"blocks\"; } spacer; ok_cancel;}"
        file
      )
      (not (setq file (close file)))
    )
  )
       )
     )
     (princ "\n** Unable to Write DCL File **")
    )
    (
     (<= (setq dc (load_dialog dcfname)) 0)
     (princ "\n** DCL File not Found **")
    )
    (
     (not (new_dialog "copyblock" dc))
     (princ "\n** Unable to Load Dialog **")
    )
    (t
     (start_list "blocks")
     (mapcar 'add_list lst)
     (end_list)
     (setq ptr (set_tile "blocks" "0"))
     (action_tile "blocks" "(setq ptr $value)")
     (setq fl (start_dialog)
    dc (unload_dialog dc)
     )
     (if (and (= 1 fl)
       (setq pt (getpoint "\nSpecify Point for Block: "))
  )
       (progn
  (vla-CopyObjects
    dbxDoc
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbObject '(0 . 0))
        (list (LM:Itemp (vla-get-blocks dbxDoc)
          (setq block (nth (atoi ptr) lst))
       )
        )
      )
    )
    acblk
  )
  (setq norm (trans '(0. 0. 1.) 1 0 t))
  (if (LM:Itemp acblk block)
    (vla-insertBlock
      spc
      (vlax-3D-point (trans pt 1 0))
      block
      1.
      1.
      1.
      (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 norm t))
    )
  )
       )
       (princ "\n*Cancel*")
     )
    )
  )
  (if (and dcfname (setq dcfname (findfile dcfname)))
    (vl-file-delete dcfname)
  )
  (if dbxDoc
    (vlax-release-object dbxDoc)
  )
  (princ)
)
;;-----------------=={ Get Document Object }==----------------;;
;;                                                            ;;
;;  Retrieves a the VLA Document Object for the specified     ;;
;;  filename. Document Object may be present in the Documents ;;
;;  collection, or obtained through ObjectDBX                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - www.lee-mac.com             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  filename - filename for which to retrieve document object ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Document Object, else nil                   ;;
;;------------------------------------------------------------;;
(defun LM:GetDocumentObject (filename / acdocs dbx)
  (vl-load-com)
  ;; © Lee Mac 2010
  (vlax-map-collection
    (vla-get-Documents (vlax-get-acad-object))
    (function
      (lambda (doc)
 (setq acdocs
        (cons
   (cons (strcase (vla-get-fullname doc)) doc)
   acdocs
        )
 )
      )
    )
  )
  (cond
    ((not (setq filename (findfile filename))) nil)
    ((cdr (assoc (strcase filename) acdocs)))
    ((not
       (vl-catch-all-error-p
  (vl-catch-all-apply
    'vla-open
    (list (setq dbx (LM:ObjectDBXDocument)) filename)
  )
       )
     )
     dbx
    )
  )
)
;;-----------------=={ ObjectDBX Document }==-----------------;;
;;                                                            ;;
;;  Retrieves a version specific ObjectDBX Document object    ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - www.lee-mac.com             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  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 - www.lee-mac.com             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  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
  )
)

(defun getnames (xlsfname / nName) ;<<xlsfname - provide valid filename with path
  (vl-load-com)
     ;make proper excel objects
  (setq
    xlApp   (vlax-create-object "Excel.Application")
    xlWBook (vlax-get xlApp "Workbooks")
    xlFile  (vlax-invoke-method xlWBook "Open" xlsfname)
    xlNames (vlax-get xlFile "Names")
  )
     ;make excel unvisible
  (vlax-put-property xlApp "Visible" :vlax-false)
     ;names count from opened workbook
  (setq ncnt (vlax-get-property xlNames "Count"))
     ;set nil to var containing names
  (setq nName nil)
     ;set counter
  (setq i 1)
     ;put names to var
  (while (< i (1+ ncnt))
    (setq xlNName (vlax-invoke xlNames "Item" i))
     ;<<<< vlax-invoke instead of vlax-get-property, that was a catch, thank you!
    (setq nName (cons (vlax-get-property xlNName "Name") nName))
    (setq i (1+ i))
  )
     ;sort list of names
  (setq nName (vl-sort nName '<))
     ;close excel file without saving
  (vlax-invoke-method xlFile 'Close :vlax-False)
     ;quit excel
  (vl-catch-all-apply 'vlax-invoke-method (list xlApp 'Quit))
     ;release objects
  (mapcar '(lambda (x) (vlax-release-object x))
   (list xlNName xlNames xlFile xlWBook xlApp)
  )
     ;clear vars
  (mapcar '(lambda (x) (setq x nil) (gc))
   (list i xlNName xlNames xlFile xlWBook xlApp)
  )
     ;garbage collection
  (gc)
  (gc)
  nName     ;<<return list of names from xlsfname
)

(defun SelectXlsFileName ( / xl)
  (setq xl (getfiled "Select Excel File" "" "xls" 0))(if (and xl (findfile xl))xl nil))
(defun c:tst ( / xl)(if (setq xl (SelectXlsFileName))(getnames xl)))

[Dadgad]

Outstanding rlx, the lisp cavalry has arrived!
Vintage Lee Mac from the looks of it, no longer on his website.

[rlx]

Outstanding rlx, the lisp cavalry has arrived!
Vintage Lee Mac from the looks of it, no longer on his website.

yeah , used it for study when I created my own block routine but that one is a little over the top so thought it would be a better idea to show Lee's version (btw , congratulations Lee with your birthday , yesterday I believe)