Topic: Update block definition from block inside external DWG

[Marc'Antonio Alessi]

Many years ago I wrote a function (below) to update a block (nested or not) by inserting a DWG file that contains the objects of that block.
If the file has a different name from the block the block is renamed.

I would like to write a similar function that allows me to insert a DWG that contains the block definition (and other blocks...) than updates the block with the same name.
The best would be to update the nested blocks it contains.

Scenario:
1) Main.dwg contains the block MyBlockAbc
2) MyBlockAbc contains SubBlock1 SubBlock2
3) select MyBlockAbc (can be a nested block) from Main.dwg
4) select a DWG file via dialogue, example Foo.dwg
5) update all blocks MyBlockAbc SubBlock1 SubBlock2 in Main.dwg from definitions on Foo.dwg

Any suggestion?

Code: [Select]

(defun C:ALE_BLK_REINS ( / EntDat EntNam BlkNam PatNam FilNam NewNam EntLst UpdNam NumObj)
      (MODESET '("ATTREQ" "EXPERT"))
      (setvar "EXPERT" 5) (setvar "ATTREQ" 0)
      (if (setq EntLst (nentsel "\nSelect main or nested block to update: "))
        (progn
          (if (= (length EntLst) 4)
            (progn
              (if (and (= "DIMENSION" (DXF 0 (entget (car (last EntLst))))) (cdr (last EntLst)))
                (setq EntLst (list (car EntLst) (cdr (last EntLst))))
              );if
              (setq
                UpdNam (DXF 2 (entget (last (last EntLst))))
                EntNam (car (last EntLst))
              )
              (if (setq EntDat (entget EntNam)) (setq BlkNam (strcase (DXF 2 EntDat))));if
            );progn
            (progn
              (setq EntNam (car EntLst))
              (if (= "ATTRIB" (DXF 0 (entget EntNam)))
                (progn
                  (setq EntNam (ssname (ssget (cadr EntLst)) 0))
                  (if (setq EntDat (entget EntNam)) (setq BlkNam (strcase (DXF 2 EntDat))));if
                );progn
              );if
            );progn
          );if
          (if BlkNam
            (if
              (and
                (= (DXF 0 EntDat) "INSERT")
                (setq
                  PatNam (ALE_UtlCfg_GetVal #CfgData "MyApp" "Ins_dir" "")
                  FilNam
                    (getfiled
                      "Block file"
                      (strcat PatNam BlkNam)
                      "DWG" 2
                    )
                  )
              )
              (progn
                (if (snvalid (setq NewNam (strcase (vl-filename-base FilNam))))
                  (progn
                    (or
                      (= (vl-filename-directory PatNam) (vl-filename-directory FilNam))
                      (ALE_UtlCfg_SetVal
                        '#CfgData #CfgFile "MyApp" "Ins_dir" (strcat (vl-filename-directory FilNam) "\\")
                      )
                    )
                    (command "_.INSERT" (strcat BlkNam "=" FilNam)) (command)
                    (if (and UpdNam (setq UpdNam (ssget "_X" (list (cons 0  "INSERT") (cons 2 UpdNam)))))
                      (progn
                        (repeat (setq NumObj (sslength UpdNam))
                          (setq NumObj (1- NumObj)) (entupd (ssname UpdNam NumObj))
                        )
                        (setq UpdNam nil)
                      )
                    )
                    (if (setq UpdNam (ssget "_X" (list (cons 0  "INSERT") (cons 2 BlkNam))))
                      (progn
                        (repeat (setq NumObj (sslength UpdNam))
                          (setq NumObj (1- NumObj)) (entupd (ssname UpdNam NumObj))
                        )
                        (setq UpdNam nil)
                      )
                    )
                    (if (equal NewNam BlkNam)
                      (princ (strcat "\nBlock " BlkNam " updated.  "))
                      (progn
                        (if (tblsearch "BLOCK" NewNam)
                          (alert (strcat
                            "\nBlock " BlkNam " updated"
                            "\nbut not renamed in " NewNam
                            "\n\nBlock " NewNam " already exist in the drawing."
                            "\n\nAttention, now the two blocks are equal but with different name!"
                          )      )
                          (progn
                            (command "_RENAME" "_BL" BlkNam NewNam)
                            (princ (strcat "\nBlock " BlkNam " updated and renamed in " NewNam "  "))
                          )
                        )
                      )
                    )
                    (and (getcname "_ATTSYNC") (= (DXF 66 EntDat) 1) (command "_.ATTSYNC" "_NAME" NewNam)) ; blocco con attributi
                  )
                  (alert
                    (strcat
                      "Block name " (chr 34) FilNam (chr 34) " not valid:"
                      "\n\n Inser has been ignored."
                  ) )
                );if
              );progn
              (princ "\nInsufficient information or non valid entity! Try again. ")
            );if
            (alert "MyApp message:\nA regen needed to modify this Block")
          )
        );progn
        (princ "\nMyApp message:\nNothing selected, function cancelled.   ")
      );if EntLst
      (MODERESET)
      (princ)
); defun C:ALE_BLK_REINS

[HasanCAD]

Subroutines not included

[Marc'Antonio Alessi]

Subroutines not included

I know... it is only an example, there are many sub to post and not needed for the question..

[Marc'Antonio Alessi]

Subroutines not included

Working version:

Code: [Select]

(defun C:ALE_BLK_REINS_2 ( / EntDat EntNam BlkNam PatNam FilNam NewNam EntLst UpdNam NumObj)
      (defun Dxf (DxfCod EntDat)  (cdr (assoc DxfCod EntDat)))
      (setvar "EXPERT" 5) (setvar "ATTREQ" 0)
      (if (setq EntLst (nentsel "\nSelect main or nested block to update: "))
        (progn
          (if (= (length EntLst) 4)
            (progn
              (if (and (= "DIMENSION" (DXF 0 (entget (car (last EntLst))))) (cdr (last EntLst)))
                (setq EntLst (list (car EntLst) (cdr (last EntLst))))
              );if
              (setq
                UpdNam (DXF 2 (entget (last (last EntLst))))
                EntNam (car (last EntLst))
              )
              (if (setq EntDat (entget EntNam)) (setq BlkNam (strcase (DXF 2 EntDat))));if
            );progn
            (progn
              (setq EntNam (car EntLst))
              (if (= "ATTRIB" (DXF 0 (entget EntNam)))
                (progn
                  (setq EntNam (ssname (ssget (cadr EntLst)) 0))
                  (if (setq EntDat (entget EntNam)) (setq BlkNam (strcase (DXF 2 EntDat))));if
                );progn
              );if
            );progn
          );if
          (if BlkNam
            (if
              (and
                (= (DXF 0 EntDat) "INSERT")
                (setq
                  PatNam ""
                  FilNam
                    (getfiled
                      "Block file"
                      (strcat PatNam BlkNam)
                      "DWG" 2
                    )
                  )
              )
              (progn
                (if (snvalid (setq NewNam (strcase (vl-filename-base FilNam))))
                  (progn
                    (command "_.INSERT" (strcat BlkNam "=" FilNam)) (command)
                    (if (and UpdNam (setq UpdNam (ssget "_X" (list (cons 0  "INSERT") (cons 2 UpdNam)))))
                      (progn
                        (repeat (setq NumObj (sslength UpdNam))
                          (setq NumObj (1- NumObj)) (entupd (ssname UpdNam NumObj))
                        )
                        (setq UpdNam nil)
                      )
                    )
                    (if (setq UpdNam (ssget "_X" (list (cons 0  "INSERT") (cons 2 BlkNam))))
                      (progn
                        (repeat (setq NumObj (sslength UpdNam))
                          (setq NumObj (1- NumObj)) (entupd (ssname UpdNam NumObj))
                        )
                        (setq UpdNam nil)
                      )
                    )
                    (if (equal NewNam BlkNam)
                      (princ (strcat "\nBlock " BlkNam " updated.  "))
                      (progn
                        (if (tblsearch "BLOCK" NewNam)
                          (alert (strcat
                            "\nBlock " BlkNam " updated"
                            "\nbut not renamed in " NewNam
                            "\n\nBlock " NewNam " already exist in the drawing."
                            "\n\nAttention, now the two blocks are equal but with different name!"
                          )      )
                          (progn
                            (command "_RENAME" "_BL" BlkNam NewNam)
                            (princ (strcat "\nBlock " BlkNam " updated and renamed in " NewNam "  "))
                          )
                        )
                      )
                    )
                    (and (getcname "_ATTSYNC") (= (DXF 66 EntDat) 1) (command "_.ATTSYNC" "_NAME" NewNam)) ; blocco con attributi
                  )
                  (alert
                    (strcat
                      "Block name " (chr 34) FilNam (chr 34) " not valid:"
                      "\n\n Inser has been ignored."
                  ) )
                );if
              );progn
              (princ "\nInsufficient information or non valid entity! Try again. ")
            );if
            (alert "MyApp message:\nA regen needed to modify this Block")
          )
        );progn
        (princ "\nMyApp message:\nNothing selected, function cancelled.   ")
      );if EntLst
      (setvar "EXPERT" 0) (setvar "ATTREQ" 1)
      (princ)
)

[MP]

I'm on my mobile so posting code isn't an option. That said, you're working harder than you need to. Use a temp doc (via objectdbx) to host (via copy) the block definition hosted by the external drawing you referred to in your original post (also opened via objectdbx). That is, the temp dbx doc's model space replicates the block def you're interested in (including any child block instances). Save the temp dbx to a temp dwg, then insert = said temp dwg. tl;dr: shazam.

[MP]

Bashed this out over lunch. Should be 90% of what you need Marc.

Code: [Select]

(defun mpx-copy-block-to-ms-in-new-doc ( source-dwg block-name / :item :objects :copy-objects :create-odbx-doc :release-docs :main )

    ;;  Michael Puckett, 2018-03-26.
    ;;
    ;;  Written quick and dirty for my friend Marc'Antonio Alessi.
    ;;
    ;;  (mpx-copy-block-to-ms-in-new-doc
    ;;      "c:\\an-existing-drawing.dwg"
    ;;      "some-block-name-in-existing-drawing"
    ;;  )
    ;;
    ;;  If successful returns the name of a new drawing that
    ;;  hosts the desired block's contents in modelspace so that
    ;;  the drawing may be used in an insert=drawing construct
    ;;  to re-define a block.

    (defun :item ( owner key / item )
        (vl-catch-all-apply 'eval
           '((setq item (vla-item owner key)))
        )
        item
    )
   
    (defun :objects ( owner / lst )
        (vl-catch-all-apply 'eval
           '((vlax-for x owner (setq lst (cons x lst))))
        )
        (reverse lst)
    )
   
    (defun :copy-objects ( source-doc objects new-owner / result )
        (vl-catch-all-apply 'eval
           '(   (progn   
                    (vlax-invoke-method
                        source-doc
                       'CopyObjects
                        (vlax-safearray-fill
                            (vlax-make-safearray vlax-vbObject (cons 0 (1- (length objects))))
                            objects
                        )
                        new-owner
                    )
                    (setq result t)
                )
            )       
        )
        result
    )
   
    (defun :create-odbx-doc ( )
        (   (lambda ( pid vid )
                (vla-getinterfaceobject
                    (vlax-get-acad-object)
                    (if (< 15 vid)
                        (strcat pid (strcat "." (itoa vid)))
                        pid
                    )
                )
            )
            "ObjectDBX.AxDbDocument"
            (atoi (getvar "acadver"))
        )
    )
   
    (defun :release-docs ( docs )
        (foreach x (mapcar 'list docs)
            (vl-catch-all-apply 'vla-close x)
            (vl-catch-all-apply 'vlax-release-object x)       
        )
    )
   
    (defun :main ( source-dwg block-name / temp-dwg source-doc block objects new-doc new-name result )
   
        (and
       
            (setq temp-dwg (vl-filename-mktemp "temp.dwg"))
           
            (vl-file-copy source-dwg temp-dwg)
       
            (findfile temp-dwg)
       
            (setq source-doc (:create-odbx-doc))
           
            (progn
                (vl-catch-all-apply 'vla-open (list source-doc temp-dwg))
                (setq block (:item (vla-get-blocks source-doc) block-name))
            )
           
            (setq objects (:objects block))
           
            (setq new-doc (:create-odbx-doc))
           
            (:copy-objects source-doc objects (vla-get-modelspace new-doc))
           
            (setq new-name (vl-filename-mktemp "temp.dwg"))
           
            (progn
                (vl-catch-all-apply 'vla-saveas (list new-doc new-name))
                (if (findfile new-name)
                    (setq result new-name)
                )         
            )
        )
       
        (:release-docs (list source-doc new-doc))
        (vl-catch-all-apply 'vl-file-delete (list temp-path))
           
        result
   
    )
   
    (:main source-dwg block-name)
   
)
Cheers.

[Marc'Antonio Alessi]

Bashed this out over lunch. Should be 90% of what you need Marc.
... Cheers.

;;  Written quick and dirty for my friend Marc'Antonio Alessi.
  Grazie Michael! Tomorrow I will examine your proposal carefully.
>>...you're working harder than you need to...
My sample was a very old function written first time about 25 years ago (I'm still using).
Thanks again, goodnight.

[roy_043]

If you delete all objects from the original block definition, you can use it as the target for the CopyObjects method. What is the benefit of creating an intermediate temp.dwg?
Note 1:
Pay attention to block properties (blockscaling, comments, explodable and units).
Note 2:
Remember to also clone the draworder.

[MP]

(1) I work in an environment where dwg corruption is common (in active or external dwgs) so I frequently exploit temporary (pristine) dbx docs, (2) sometime it's faster to fill an empty bucket than to empty one and fill it back up, (3) thought I would share and (4) this.

[Marc'Antonio Alessi]

Bashed this out over lunch. Should be 90% of what you need Marc.
<clip>

Michael,
(mpx-copy-block-to-ms-in-new-doc "Z:\\Temp\\foo.dwg" "MyBlockAbc")  do not update... maybe I use in wrong mode...

Edit: All ok I had not read this note well:
>> If successful returns the name of a new drawing that  hosts the desired block's contents in modelspace so that the drawing may be used in an insert=drawing construct to re-define a block.
My apologies. 

before you post mpx-copy-block-to-ms-in-new-doc I was trying with this method (I think that's what Roy suggests):

Code: [Select]

;(ALE_Block_UpdByBlkInFile (cons "MyBlockAbc" "Z:\\Temp\\foo.dwg") (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object))) nil)
;(ALE_Block_UpdByBlkInFile (cons "SubBlock1"  "Z:\\Temp\\foo.dwg") (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object))) nil)
;
;                   Original               New Block Def
; BlkInf = List '("BlockName" . "c:\\Temp\\SourceFile.dwg")
; BksCol = (vla-get-blocks DbxDoc)
; BitVal = not used
;
; (ALE_Block_UpdByBlkInFile (cons BlkNam FilNam) (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object))) nil)
;
(defun ALE_Block_UpdByBlkInFile (BlkInf BksCol BitVal / BksSrc DbxDoc FilNam BksSrc BlkSrc BlkObj ObjLst BlkNam WhoStr WhoInf ErrFlg)
  (defun ALE_Utl_GetItem (VlaCol KeyNam / VlaObj)
    (vl-catch-all-apply
     '(lambda ( )
        (setq VlaObj (vla-item VlaCol KeyNam))
      )
    )
    VlaObj
  )
  (setq
    BlkNam (car BlkInf)    FilNam (cdr BlkInf)
    DbxDoc (vla-GetInterfaceObject *AcadApp* (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2)))
    ErrFlg (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list DbxDoc FilNam)))
  )
  (cond
    ( ErrFlg (alert "Unable to open drawing.") ) ; (ALE_Files_WhoHasPrompt FilNam)
    ( (and
        (setq BlkObj (ALE_Utl_GetItem BksCol BlkNam)) ;destination block del file aperto
        (setq BksSrc (vla-get-Blocks DbxDoc))         ;source blocks coll.
        (setq BlkSrc (ALE_Utl_GetItem BksSrc BlkNam)) ;source block
      )
      (vlax-for ObjFor BlkObj (vla-delete ObjFor))   ;delete existing items on destination block
      (vlax-for ObjFor BlkSrc (setq ObjLst (cons ObjFor ObjLst)))
      (vlax-invoke DbxDoc 'copyobjects ObjLst BlkObj);copy objects from source drawing to destination block
      (vlax-release-object BlkObj)(vlax-release-object BksSrc)
    )
    ( T
      (setq ErrFlg T)
      (alert (strcat "\nBlock: "  BlkNam " not found on selected Dwg!"      ))
    )
  )
  (and DbxDoc (or (vlax-object-released-p DbxDoc) (vlax-release-object DbxDoc)))
  (not ErrFlg)
)
The results are in the attached files, now I see if I can also update the nested blocks in a single pass...

[roy_043]

@MP:
1.
If there is a form of corruption related to the entities that are being copied, and the CopyObjects method copies this corruption, how does using a temp dwg fix things?
2.
It seems unlikely that a process that involves writing a file to disc is faster.
3.
Thanks.
4.
The brevity of my message has confused you perhaps.

[MP]

1. How is beyond my ability to articulate. I will offer that dwg corruption typically isn't with the entities we're interested in but other data structures in the hosting drawing that form a linked labyrinth difficult to separate from "the good stuff". A common example are models polluted with AEC garbage that are not remedied by any amount of progressive purging, auditing, dictionary deletion or wblock* techniques etc. Since they're models the problems tend to cascade via x-refing. Recreating afflicted models using the new dbx doc technique has proven effective (and quick) so it's become somewhat of a goto maneuver. Perhaps overkill here I'll acknowledge.
2. True.
3. Thanks.
4. Got me, lol.

[Marc'Antonio Alessi]

Michael, I do not know if I'm wrong but:

>> If successful returns the name of a new drawing that  hosts the desired block's contents in modelspace so that the drawing may be used in an insert=drawing construct to re-define a block.

If I inser a drawing with "insertA=path\\drawing1.dwg"  only the "drawing1" block definition is updated (that is all the drawing) not the "insertA" that is inside?
Edit: If I inser a drawing with "insertA=path\\drawing1.dwg"  the "insertA" block definition is updated with drawing1 (that is all the drawing) not the "insertA" that is inside?
or maybe it is non possible because create a ricursive block.

[MP]

You're not wrong Marc - my desire to help has not ensured I fully understood your requirement nor has prevented my incompetence from catching up to my fatigue - my apologies to you and the forum for the distraction my participation here has birthed.

[Marc'Antonio Alessi]

Your contribution was very very interesting, in particular for: >>...Recreating afflicted models using the new dbx doc technique has proven to be effective (and quick)...

I'm trying to write a recursive function to also update the nested blocks, I hope someone will participate...
Grazie.