Lisp Help. Import certain blocks and attributes from another drawing

Hi!

I am in a desperate need of a LISP routine to do the following.

I have a folder with .dwg files. These are old versions of the documents, and I need to import blocks and attribute values from them to the current drawing.
When the user types the command to start the lisp in the current drawing, the following things should happen:

1. Ask user for folder path (command line, no GUI)
2. Lisp tries to find a match of current document name to a drawing found in the folder -> If match found then continue, otherwise present user with an error.
3. Find all blocks where the name starts with "REV." from the folder document (REV.A, REV.B....), insert them to the current drawing. IMPORTANT, the position must match!
4. From the folder file, copy this list of attributes from a block named "A4" to the current drawing (current drawing also contains a block "A4", but I can't copy the whole block. I need only certain attributes to be updated!)

Code:

---

A list of attribute names in block "A4" that needs to be copied from the folder drawing -> Active drawing

DRAWN
DATE
REV
REV_A
DATE_A
DRAWN_A
REV_B
DATE_B
DRAWN_B
REV_C
DATE_C
DRAWN_C
REV_D
DATE_D
DRAWN_D
REV_E
DATE_E
DRAWN_E
REV_F
DATE_F
DRAWN_F

---

I have tried to modify a lisp by Lee Mac (But with super bad success)

Code:

---

;;----------------------=={ Copy Block }==--------------------;;
;;                                                            ;;
;;  Copies the selected block definition from the selected    ;;
;;  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            ;;
;;------------------------------------------------------------;;

(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
        (and dbxDoc (vlax-release-object dbxDoc))   
        (and file (eq 'FILE (type file)) (setq file (close file)))   
        (and dcfname (setq dcfname (findfile dcfname)) (vl-file-delete dcfname))   
        (and 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*")
      )
    )
  )

  (and dcfname (setq dcfname (findfile dcfname)) (vl-file-delete dcfname))
 
  (and 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                              ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.  ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net            ;;
;;------------------------------------------------------------;;
;;  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))) )
    ( (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                              ;;
;;                                                            ;;
;;  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
  )
)

---

Is anybody here helping me out?

What went wrong using Lee's code ?

He also has Steal.lsp that can be driven via lisp so no user input. I will try to find the lisp I did.

Code:

---

(defun c:stealblocks ()
(load "p:\\Autodesk\\lisp\\stealV1-6")
(command "script" "p:\\Autodesk\\lisp\\steal-blocks") ; need to find this script.
)

---

Quote:

---

Originally Posted by BIG-AL

What went wrong using Lee's code ?

He also has Steal.lsp that can be driven via lisp so no user input. I will try to find the lisp I did.

Code:

---

(defun c:stealblocks ()
(load "p:\\Autodesk\\lisp\\stealV1-6")
(command "script" "p:\\Autodesk\\lisp\\steal-blocks") ; need to find this script.
)

---

---

I struggle with modifying it for my specific needs. I am a total newb with Lisp so understanding the code is a bit of a struggle.
I have already tried that steal LISP, and it requires user input so it will not work for me (and for some reason it never got the objects stolen :D)

This is what I came up with during this weekend. I am 99% sure it works as intended until the point where I try to copy the block.

Code:

---


;-----------------------------------------------------------------------------
;Update current drawing with source drawing (get attributes from block A4, and copy
;all blocks that start with REV.
;----------------------------------------------------------------------------

;Main Loop
(defun c:UpRev (/ FileName FolderPath FindPath FoundFile) ;Filename = Drawing to be updated, Folderpath = Folder of the source file; FindPath = Folderpath + Filename, FoundFile = return value if file is found in folder
  (setq FileName (getvar "dwgname")) ;Get Current DWG name
  (setq FolderPath (getstring "\Anna Pohja kansio: ")) ;Ask user for folder where source is located
  (setq FindPath (strcat FolderPath "\\" Filename)) ;Create findpath string
  (setq FoundFile (findfile FindPath))
  (if FoundFile
    (progn
    (setq Dbx (open_dbx FindPath)) ; If file is found, open it with open_dbx function
    (vla-CopyObjects ;This part is where I am strugling. I cant get even 1 block copied (REV.A). How to loop all blocks, and copy the ones that STARTS with "REV."? How to get a list of attributes from block A4?
      Dbx
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbObject '(0 . 0))
        (list (vla-item (vla-get-blocks dbx) "REV.A"))
      )
      (vla-get-blocks
        (vla-get-activedocument (vlax-get-acad-object))
      )
    )
    )
    (alert "NO FILE FOUND")
  )
 (vlax-release-object dbx)
)

;Code to open a dbx object, this seems to work OK
(defun open_dbx        (dwg / dbx)
  (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
    (setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
    (setq dbx (vlax-create-object
                (strcat        "ObjectDBX.AxDbDocument."
                        (substr (getvar "ACADVER") 1 2)
                )
              )
    )
  )
  (vla-open dbx dwg)
  dbx
)

---

Got help from another forum. Here is the complete and working code if anyone stumbles across this:

Code:

---

(defun c:Test (/ DBX_Import DBX_Open GetBlockReferences GetAttributeValues PushAttributeValues T_Folder T_File T_SourceDrawing T_SourceModel T_TargetModel T_TargetBlockList T_RevisionHistory)

  (defun DBX_Import (DI_DBXDoc DI_DBXObject DI_Target)
      (vla-CopyObjects DI_DBXDoc
        (vlax-make-variant
            (vlax-safearray-fill
              (vlax-make-safearray vlax-vbObject '(0 . 0))
                  (list DI_DBXObject)
            )
        )
        DI_Target
      )
  )

  (defun DBX_Open (DO_FileName DO_ReadOnly / DO_DbxObject DO_DbxDWG) 
      (setq DO_DbxObject (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2)))     
      (if
        (and
            (not (vl-catch-all-error-p (setq DO_DbxDWG (vl-catch-all-apply 'vla-GetInterfaceObject (list (vlax-get-acad-object) DO_DbxObject)))))                 
            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list DO_DbxDWG DO_FileName DO_ReadOnly)))  )
        )
        DO_DbxDWG       
      )     
  )

  (defun GetBlockReferences (GBR_BlockName / GBR_BlockObject)
      (if
        (and
            (= (type GBR_BlockName) 'STR)
            (not (vl-catch-all-error-p (setq GBR_BlockObject (vl-catch-all-apply 'vla-item (list (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) GBR_BlockName)))))       
        )
        (vl-remove-if
            'not
            (mapcar
              'vlax-ename->vla-object
              (mapcar
                  'cdr
                  (vl-remove-if-not
                    '(lambda (GBR_Item) (= (car GBR_Item) 331))
                    (entget (vlax-vla-object->ename GBR_BlockObject))
                  )
              )
            )
        )
      )
  )

  (defun GetAttributeValues (GAV_BlockObject GAV_TagList / GAV_AttributeList GAV_Tag GAV_ReturnList)
      (if
        (and
            (= (type GAV_BlockObject) 'VLA-OBJECT)
            (= (vla-get-ObjectName GAV_BlockObject) "AcDbBlockReference")
            (= (vla-get-HasAttributes GAV_BlockObject) :vlax-true)
        )
        (progn
            (setq GAV_AttributeList (vlax-safearray->list (vlax-variant-value  (vla-GetAttributes GAV_BlockObject))))
            (foreach GAV_Item GAV_AttributeList
              (if
                  (or
                    (member (setq GAV_Tag (vla-get-TagString GAV_Item)) GAV_TagList)
                    (not GAV_TagList)                   
                  )
                  (setq GAV_ReturnList (cons (cons GAV_Tag (vla-get-TextString GAV_Item)) GAV_ReturnList))
              )
            )
        )
      )
      GAV_ReturnList
  )

  (defun PushAttributeValues (PAV_BlockObject PAV_TagValueList / PAV_AttributeList PAV_Found)
      (if
        (and
            (= (type PAV_BlockObject) 'VLA-OBJECT)
            (= (vla-get-ObjectName PAV_BlockObject) "AcDbBlockReference")
            (= (vla-get-HasAttributes PAV_BlockObject) :vlax-true)
            (listp PAV_TagValueList)
        )
        (progn
            (setq PAV_AttributeList (vlax-safearray->list (vlax-variant-value  (vla-GetAttributes PAV_BlockObject))))
            (foreach PAV_Item PAV_AttributeList
              (if
                  (setq PAV_Found (assoc (vla-get-TagString PAV_Item) PAV_TagValueList))                                                           
                  (vla-put-TextString PAV_Item (cdr PAV_Found))
              )
            )
        )
      )     
  )
 
 
  (if
      (and
        (/= (setq T_Folder (getstring "\nEnter folder name: ")) "")
        (setq T_File (findfile (strcat T_Folder (getvar "DWGNAME"))))
      )
      (progn
        (if
            (setq T_SourceDrawing (DBX_Open T_File :vlax-true))
            (progn
              (setq T_SourceModel    (vla-get-ModelSpace T_SourceDrawing))
              (setq T_TargetModel    (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
              (setq T_TargetBlockList (GetBlockReferences "A4"))
              (vlax-for T_Object T_SourceModel
                  (if                   
                    (= (vla-get-ObjectName T_Object) "AcDbBlockReference")                                                   
                    (progn
                        (cond
                          (
                              (wcmatch (vla-get-EffectiveName T_Object) "REV`.*")
                              (DBX_Import T_SourceDrawing T_Object (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
                          )
                          (
                              (and
                                (= (vla-get-EffectiveName T_Object) "A4")
                                T_TargetBlockList
                              )                             
                              (setq T_RevisionHistory (GetAttributeValues T_Object '("DRAWN" "DATE" "REV" "REV_A" "DATE_A" "DRAWN_A" "REV_B" "DATE_B" "DRAWN_B" "REV_C" "DATE_C" "DRAWN_C" "REV_D" "DATE_D" "DRAWN_D" "REV_E" "DATE_E" "DRAWN_E" "REV_F" "DATE_F" "DRAWN_F")))                           
                          )
                          (
                              T
                              nil
                          )
                        )
                    )
                  )
              )
              (if
                  (and
                    T_TargetBlockList
                    T_RevisionHistory
                  )
                  (foreach T_Item T_TargetBlockList
                    (PushAttributeValues T_Item T_RevisionHistory)
                  )
              )
              (vlax-release-object T_TargetModel)
              (vlax-release-object T_SourceModel)
              (vlax-release-object T_SourceDrawing)
              (princ "\n ** Drawing found & processed!")
            )
            (princ "\n ** Error opening source drawing!")
        )
      )
      (princ "\n ** Incorrect folder or drawing file not found!")
  )
  (princ)
)

---