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

[BIGAL]

You could rewrite to ask block name but still look in ATCW master, by doing this you imply the layer name "draft" and you can add the underscore also to name and create that layer as well.

 

Not tested

(defun c:myblock ( / blkname)
(if (not steal)(load "stealv1-6")) ; check version of lee's steal
(setq blkname (getstring "Enter Block name"))
(Steal "R:\\Drafting\\ATCW Standards\\ATCW Master.dwg"
'(
("Blocks" (blkname))
(command "-layer" "a" "s" blkname "" "" "")
(command "-layer" "n" (strcat "_" blkname) "c" "7" "" "m" (strcat "_" blkname) "" "")
(command "-Insert" blkname "0,0" "" "" "")
(command "-layer" "a" "r" blkname "d" blkname "" "")
)
)
)

[pbelon]

On 4/13/2018 at 8:14 AM, rlx said:

;;--------------=={ 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 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  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 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  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 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  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 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  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
 )
)

It's posible to modify the program just to do the inverse?. I mean just check for equal blocks and update them from the other drawing.

 

Thanks.

 

 

[tombu]

On 4/13/2018 at 1:41 AM, Mark_ATCW said:

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'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.

Lee's Example at that link takes Layers and Dimension Styles from a drawing:

The following example will attempt to import Layers: 'Layer1' & 'Layer2', and all Dimension Styles beginning with DimStyle from the drawing: 'C:\My Folder\MyDrawing.dwg' into the current drawing. I use it for everything, Thanks Lee!

If you post the drawing with it's path like he shows in that example along with the block name and let us know if it's for a macro or to be called from lisp we could write it for you.

[RaKaMa]

No mention of design centre, it does still exist I believe but maybe renamed.

Ctrl+2 to open (AC 2006)