Import spesific blocks and attributes from another drawing

[Anonymous]

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!)

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

This is the Code that I have so far (i think everything is correct until i try to copy the REV.A block). This script lacks the copying of all blocks and attribute transfer of block A4

;-----------------------------------------------------------------------------
;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) 
)

[patrick_35]

Hi

You just copy a definition in table of blocks

An example to copy a object in ModelSpace

(setq dbx (vla-item (vla-get-documents (vlax-get-acad-object)) "A_DRAWING_ALREADY_OPEN"))
(setq mso (vla-get-modelspace dbx))
(setq obj (vla-item mso 0)) ; Just the first object. It's up to you to find the block
(vlax-invoke dbx 'copyobjects (list obj) (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))); Copy object

@+

[DannyNL]

To help with the part you are struggling with; the CopyObjects method requires a variant not a safearray.

So try this:

(vla-CopyObjects
   Dbx
   (vlax-make-variant
      (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))
   )
)

Hope this helps a bit.

[Anonymous]

Thank you for taking your time and trying to help me!

For some reason, it will still not copy the block from the original drawing to the active one.

I am a total newb with this 

Is there a way to see what happens in the debugger? For example, can I see what blocks it found in the drawing?  I tried executing the code step by step, but it didn't throw any errors. Nothing just happened.

The watch window doesn't work the way I am used to (from VBA)

[patrick_35]

Did you try the example I gave you? Already to understand how CopyObjects works and then to adapt it.

@+

[Anonymous]

Sorry, I missed your post totally.

Yes I got that one working (it copies the first block)

I will try to get this incorporated in my current lisp, the thing is that I am so inexperienced in it that any help how I would do that (and loop the blocks for blocks named "REV.Something" and get the attributes from Block A4 ) is appreciated. Still, thank you so much this is a great start!

[patrick_35]

Since it copies the 1st object, it is necessary to make a loop with conditions to find the desired block

For example to find my block and copy this

(vlax-for ent mso
  (if (and (eq (vla-get-objectname ent) "AcDbBlockReference")
	   (eq (strcase (vla-get-effectivename ent)) "REV.A")
	   ...
      )
    (or obj (setq obj ent))
  )
)
(setq new (vlax-invoke dbx 'copyobjects (list obj) (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))))
(vlax-invoke (car new) 'getattributes)

@+

[DannyNL]

I had some rare time to spare, so please see below for a working example for 1 to 3.

If providing a folder name make sure to end with the name with \ 

Not sure what you are trying to with 4 though. Do you need to redefine block A4 to get some additional attributes in your current drawing? If so, it will be easier to get the block redefined in the current drawing and use attribute sync to get the new attributes in your current block.

(defun c:Test (/ DBX_Import DBX_Open T_Folder T_File T_SourceDrawing T_SourceModel T_TargetModel)

   (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        
      )       
   )
   
   (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))))
               (vlax-for T_Object T_SourceModel
                  (if
                     (and
                        (= (vla-get-ObjectName T_Object) "AcDbBlockReference")
                        (wcmatch (vla-get-EffectiveName T_Object) "REV`.*")         
                     )
                     (progn
                        (DBX_Import T_SourceDrawing T_Object (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
                     )
                  )
               )            
               (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)
)

[Anonymous]

OH MY! It works brilliantly! Thank you so much!

For number 4:

We have an external program that together with a lisp routine creates our drawings. Most of the time we do update revisions by hand. The block "A4" Contains a set of attributes where we store this revision history. It also contains product information.

In the case that our product significantly changes, we generate a new drawing. This means that the newly generated drawing is missing all of the revision history. 

So basically we would need to loop the original drawings "A4" block and transfer the attributes I listed in the original post to the new drawing. We can't import all of them (it would override the product information that might have changed).

Currently, I do hundreds of these by hand. I open the original, copy revision blocks and the revision history to the new drawing. A complete waste of time 😄

[DannyNL · Accepted solution]

Aah....OK, that makes it clear. You do not actually want to have the attribute tags but the attribute values copied, so the revision history is the same.

See the modified code below that will cover all your points from 1 thru 4.

I've used some (old) existing sub routines from my own library to complete the code and the code can probably be more compressed and optimized, but it does the job. And I actually prefer readability over optimization, so I didn't really bother to be honest 

(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)
)

[Anonymous]

OH you have no idea how much time you have saved me. Thank you so much! This works exactly how I wanted. I did today 50 updates with a batch program, it took me about 30mins. Before this, it was easily 2-3h of work. Thank you!

[DannyNL · Accepted solution]

You're welcome & glad I could help 

One small tiny thing that you may or may not have use for, but if you change the line below to include the 'T' parameter, it will allow you to enter folder names that contains spaces as well. Not sure if you have these but better be safe than sorry 

...
   (/= (setq T_Folder (getstring T "\nEnter folder name: ")) "")
...