Author Topic: Update block definition from block inside external DWG  (Read 10134 times)

0 Members and 1 Guest are viewing this topic.

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Update block definition from block inside external DWG
« Reply #15 on: March 27, 2018, 10:55:16 AM »
This seems works, I do not know if there are negative effects - Version 1.02 - 2018/04/04:
Code: [Select]
; Function: ALE_Block_UpdByBlkInFile
;
; Version 1.02 - 2018/04/04
;
; BlkNam = "BlockName"                > Original      > String
; FilNam = "C:\\Temp\\SourceFile.dwg" > New Block Def > String
; BksCol = (vla-get-blocks Doc)
; BitVal = not used
;
(or *AcadApp* (setq *AcadApp* (vlax-get-Acad-Object)            ))           ; edit 20210321
(or *AcAcDwg* (setq *AcAcDwg* (vla-get-ActiveDocument *AcadApp*)))          ; edit 20210321
;
; (ALE_Block_UpdByBlkInFile BlkNam FilNam (vla-get-Blocks *AcAcDwg*) nil)    ; edit 20210321

;
(defun ALE_Block_UpdByBlkInFile (BlkNam FilNam BksCol BitVal / DbxDoc BksSrc BlkSrc BlkObj ObjLst ForNam WhoStr WhoInf ErrFlg BlkLst)
  (setq
    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.") )
    ( (and
        (setq BlkObj (ALE_Utl_GetItem BksCol BlkNam)) ;destination block
        (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
        (and
          (= "AcDbBlockReference" (vla-get-ObjectName ObjFor))
          (not (vl-position (setq ForNam (vla-get-EffectiveName ObjFor)) BlkLst))
          (setq BlkLst (cons ForNam BlkLst))
          (setq BlkLst (ALE_Block_UpdByNestedBlkInFile BlkLst ForNam BksCol BksSrc DbxDoc BitVal))
        )
        (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)
      (vla-regen *AcAcDwg* acActiveViewport)
      (princ (strcat "\nnBlock " BlkNam " Updated. "   ))
    )
    ( 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)
)
;
; Recursive
;
(defun ALE_Block_UpdByNestedBlkInFile (BlkLst BlkNam BksCol BksSrc DbxDoc BitVal / BlkObj ObjLst ForNam)
  (if (setq BlkObj (ALE_Utl_GetItem BksCol BlkNam))
    (progn
      (vlax-for ObjFor BlkObj (vla-delete ObjFor))
      (vlax-for ObjFor (ALE_Utl_GetItem BksSrc BlkNam)
        (and
          (= "AcDbBlockReference" (vla-get-ObjectName ObjFor))
          (not (vl-position (setq ForNam (vla-get-EffectiveName ObjFor)) BlkLst))
          (setq BlkLst (cons ForNam BlkLst))
          (setq BlkLst (ALE_Block_UpdByNestedBlkInFile BlkLst ForNam BksCol BksSrc DbxDoc BitVal))
        )
        (setq ObjLst (cons ObjFor ObjLst))
      )
      (vlax-invoke DbxDoc 'copyobjects ObjLst BlkObj)
      (vlax-release-object BlkObj)
      (princ (strcat "\nnBlock " BlkNam " Updated. "   ))
    )
  )
  BlkLst
)
(defun ALE_Utl_GetItem (VlaCol KeyNam / VlaObj)
  (vl-catch-all-apply
   '(lambda ( )
      (setq VlaObj (vla-item VlaCol KeyNam))
    )
  )
  VlaObj
)

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Update block definition from block inside external DWG
« Reply #16 on: March 28, 2018, 04:27:30 AM »
@Marc'Antonio Alessi:
I am not sure if this qualifies as a negative effect but your code will update a block definition for every insert it encounters. If the main block "A" contains 10 inserts "B", the "B" block definition will be updated 10 times. To make the code more efficient consider using some sort of doneBlockNameList.
Or work with a blockNameList and an index. For every insert check if the name is already part of the blockNameList, if not append it. And just work through the list while raising the index.

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Update block definition from block inside external DWG
« Reply #17 on: March 28, 2018, 04:51:43 AM »
In the spirit of sharing, and FWIW, here is my block clone function. It can also be used in an ODBX context.
Code: [Select]
(defun KGA_Conv_Collection_To_List (coll / ret)
  (reverse
    (vlax-for a coll
      (setq ret (cons a ret))
    )
  )
)

(defun KGA_Sys_Apply (expr varLst / ret)
  (if (not (vl-catch-all-error-p (setq ret (vl-catch-all-apply expr varLst))))
    ret
  )
)

;;; ======================================================================
;;; Lib function: KGA_Block_Clone
;;; Purpose:      Make an accurate clone of a block under a new name.
;;;               Can be used to create a named clone from an anonymous
;;;               block and vice versa.
;;; Arguments:    srcDocObj  - Source document object.
;;;               trgDocObj  - Target document object or nil (= use the srcDocObj).
;;;               srcNme     - Source block name.
;;;               trgNme     - Target block name.
;;;               overwriteP - Overwrite flag.
;;; Return value: New block definition object.
;;; Remarks:      For an anonymous trgNme use "*U" and not just "*".
;;;               SrcBlkobj can also be a layout block.
;;;               Should not be used while refediting srcNme or trgNme. Use (getvar 'refeditname) to check.
;;;               Both the srcDocObj and the trgDocObj can be ODBX documents.
;;; Examples:     (setq obj (KGA_Block_Clone (vla-get-activedocument (vlax-get-acad-object)) nil "test" "testClone1" T))
;;;               (setq obj (KGA_Block_Clone (vla-get-activedocument (vlax-get-acad-object)) nil "test" "*U" T))
;;;               (setq obj (KGA_Block_Clone (vla-get-activedocument (vlax-get-acad-object)) nil "*U3524" "Named" T))
;;; ======================================================================
(defun KGA_Block_Clone (srcDocObj trgDocObj srcNme trgNme overwriteP / srcBlkObj trgBlksObj trgBlkObj)
  (if
    (and
      (or
        (/= (strcase srcNme) (strcase trgNme))
        (and
          srcDocObj
          trgDocObj
          (not (equal srcDocObj trgDocObj))
        )
      )
      (setq srcBlkObj (KGA_Sys_Apply 'vla-item (list (vla-get-blocks srcDocObj) srcNme)))
      (= :vlax-false (vla-get-isxref srcBlkObj))
      (setq trgBlksObj (vla-get-blocks (cond (trgDocObj) (srcDocObj))))
      (or
        (= "*U" (strcase trgNme))
        (not (setq trgBlkObj (KGA_Sys_Apply 'vla-item (list trgBlksObj trgNme))))
        (and
          overwriteP
          (= :vlax-false (vla-get-isxref trgBlkObj))
        )
      )
      (setq trgBlkObj ; This will create a new empty block even if trgNme already exists.
        (KGA_Sys_Apply 'vlax-invoke (list trgBlksObj 'add (vlax-get srcBlkObj 'origin) trgNme))
      )
    )
    (progn
      ;; Copy properties:
      (mapcar
        '(lambda (prop) (vlax-put trgBlkObj prop (vlax-get srcBlkObj prop)))
        '(blockscaling comments explodable units) ; Not the path property.
      )
      ;; Copy entities:
      (vlax-invoke srcDocObj 'copyobjects (KGA_Conv_Collection_To_List srcBlkObj) trgBlkObj)
      ;; Copy draworder (required because the CopyObjects method fails to clone this):
      (KGA_Block_DrawOrderClone srcBlkObj trgBlkObj)
      trgBlkObj
    )
  )
)

; Return value: List of objects. Last object is the top of the draworder.
(defun KGA_Block_DrawOrder (blkObj / sortArr sortTblObj)
  (if
    (and
      (= :vlax-true (vla-get-hasextensiondictionary blkObj))
      ; Using (vla-getobject) would still require the use of (KGA_Sys_Apply):
      (setq sortTblObj (KGA_Sys_Apply 'vla-item (list (vla-getextensiondictionary blkObj) "ACAD_SORTENTS")))
    )
    (progn
      (vla-getfulldraworder sortTblObj 'sortArr :vlax-false)
      (mapcar 'vlax-variant-value (vlax-safearray->list sortArr))
    )
  )
)

; The function assumes that trgBlkObj has been cloned from srcBlkObj and
; that trgBlkObj does not have a draworder.
; Return value: T or nil.
(defun KGA_Block_DrawOrderClone (srcBlkObj trgBlkObj / srcSortObjLst transLst)
  (if (setq srcSortObjLst (KGA_Block_DrawOrder srcBlkObj))
    (progn
      (setq transLst (mapcar 'cons (KGA_Conv_Collection_To_List srcBlkObj) (KGA_Conv_Collection_To_List trgBlkObj)))
      (vlax-invoke
        (vla-addobject (vla-getextensiondictionary trgBlkObj) "ACAD_SORTENTS" "AcDbSortentsTable")
        'setrelativedraworder
        (mapcar '(lambda (obj) (cdr (assoc obj transLst))) srcSortObjLst)
      )
      T
    )
  )
)


Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Update block definition from block inside external DWG
« Reply #19 on: April 03, 2018, 04:29:33 PM »
@Marc'Antonio Alessi:
I am not sure if this qualifies as a negative effect but your code will update a block definition for every insert it encounters. If the main block "A" contains 10 inserts "B", the "B" block definition will be updated 10 times. ...
I apologize for the big delay ... what you write is correct. I tried your function but I get an error ... I was wrong about the arguments?
Code: [Select]
Command: (setq FilNam "Z:\\Temp\\foo.dwg")
"Z:\\Temp\\foo.dwg"

Command: (setq   DbxDoc (vla-GetInterfaceObject *AcadApp* (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
#<VLA-OBJECT IAxDbDocument 00000000300ea490>

Command: (setq   ErrFlg (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list DbxDoc FilNam))))
nil

Command: (setq   obj (KGA_Block_Clone DbxDoc (vla-get-activedocument (vlax-get-acad-object))  "MyBlockAbc" "MyBlockAbc" T))
; errore: tipo di argomento errato: variantp #<VLA-OBJECT IAcadLine 000000003019e4f8>

Command: (and DbxDoc (or (vlax-object-released-p DbxDoc) (vlax-release-object DbxDoc)))
T

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Update block definition from block inside external DWG
« Reply #20 on: April 04, 2018, 03:35:45 AM »
The arguments you use seem OK. Can you test the same on BricsCAD? I suspect this may be a situation where BC is either not compatible or more tolerant.

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Update block definition from block inside external DWG
« Reply #21 on: April 04, 2018, 05:04:26 AM »
The arguments you use seem OK. Can you test the same on BricsCAD? I suspect this may be a situation where BC is either not compatible or more tolerant.
Yes you are right. In Bricscad I have no errors.
Code: [Select]
The AutoCAD error is this:
Comando: (setq   obj (KGA_Block_Clone DbxDoc (vla-get-activedocument (vlax-get-acad-object))  "MyBlockAbc" "MyBlockAbc" T))
Traccia all'indietro:
[0.80] (VL-BT)
[1.76] (ERRDUMP "tipo di argomento errato: variantp #<VLA-OBJECT IAcadLine 0000000032b5d5a8>")
[2.71] (_call-err-hook #<SUBR @0000000034781318 ERRDUMP> "tipo di argomento errato: variantp #<VLA-OBJECT IAcadLine 0000000032b5d5a8>")
[3.65] (sys-error "tipo di argomento errato: variantp #<VLA-OBJECT IAcadLine 0000000032b5d5a8>")
:ERROR-BREAK.60 nil
[4.57] (variant-value #<VLA-OBJECT IAcadLine 0000000032b5d5a8>)
[5.52] (vlax-variant-value #<VLA-OBJECT IAcadLine 0000000032b5d5a8>)
[6.47] (mapcar #<SUBR @0000000034427778 vlax-variant-value> (#<VLA-OBJECT IAcadLine 0000000032b5d5a8> #<VLA-OBJECT IAcadLine 0000000032b5e568> #<VLA-OBJECT IAcadLine 0000000032b5d1e8> #<VLA-OBJECT IAcadArc 0000000032a9a468> #<VLA-OBJECT IAcadLine 0000000032b5cca8> #<VLA-OBJECT IAcadArc 0000000032a9c3e8> #<VLA-OBJECT IAcadLWPolyline 0000000032b5e868> #<VLA-OBJECT IAcadLine 0000000032b5cd68> #<VLA-OBJECT IAcadLine 0000000032b5c0a8> #<VLA-OBJECT IAcadLine 0000000032b5c2e8> #<VLA-OBJECT IAcadLine 0000000032b5e028> #<VLA-OBJECT IAcadBlockReference 0000000032a9a548> #<VLA-OBJECT IAcadBlockReference 0000000032a9b428> #<VLA-OBJECT IAcadBlockReference 0000000032a993c8> #<VLA-OBJECT IAcadBlockReference 0000000032a9bea8>))
[7.41] (MAPCAR vlax-variant-value (#<VLA-OBJECT IAcadLine 0000000032b5d5a8> #<VLA-OBJECT IAcadLine 0000000032b5e568> #<VLA-OBJECT IAcadLine 0000000032b5d1e8> #<VLA-OBJECT IAcadArc 0000000032a9a468> #<VLA-OBJECT IAcadLine 0000000032b5cca8> #<VLA-OBJECT IAcadArc 0000000032a9c3e8> #<VLA-OBJECT IAcadLWPolyline 0000000032b5e868> #<VLA-OBJECT IAcadLine 0000000032b5cd68> #<VLA-OBJECT IAcadLine 0000000032b5c0a8> #<VLA-OBJECT IAcadLine 0000000032b5c2e8> #<VLA-OBJECT IAcadLine 0000000032b5e028> #<VLA-OBJECT IAcadBlockReference 0000000032a9a548> #<VLA-OBJECT IAcadBlockReference 0000000032a9b428> #<VLA-OBJECT IAcadBlockReference 0000000032a993c8> #<VLA-OBJECT IAcadBlockReference 0000000032a9bea8>))
[8.35] (KGA_BLOCK_DRAWORDER #<VLA-OBJECT IAcadBlock 0000000030097638>)
[9.30] (KGA_BLOCK_DRAWORDERCLONE #<VLA-OBJECT IAcadBlock 0000000030097638> #<VLA-OBJECT IAcadBlock 0000000030096738>)
[10.24] (KGA_BLOCK_CLONE #<VLA-OBJECT IAxDbDocument 00000000328fa960> #<VLA-OBJECT IAcadDocument 0000000032853648> "MyBlockAbc" "MyBlockAbc" T)
[11.15] (#<SUBR @0000000034781638 -rts_top->)
[12.12] (#<SUBR @0000000033968700 veval-str-body> "(setq   obj (KGA_Block_Clone DbxDoc (vla-get-activedocument (vlax-get-acad-object))  \"MyBlockAbc\" \"MyBlockAbc\" T))" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)

However, if I inhibit:  ; (KGA_Block_DrawOrderClone srcBlkObj trgBlkObj)   in AutoCAD I get a different result, see attached files.
Note: nested blocks are not updated under any circumstances.

Code: [Select]
Test lines:
(defun errdump (s) (vl-bt) (princ)) (setq *error* errdump)
(setq FilNam "Z:\\Temp\\foo.dwg")
(setq   DbxDoc (vla-GetInterfaceObject *AcadApp* (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
(setq   ErrFlg (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list DbxDoc FilNam))))
(setq   obj (KGA_Block_Clone DbxDoc (vla-get-activedocument (vlax-get-acad-object))  "MyBlockAbc" "MyBlockAbc" T))
(and DbxDoc (or (vlax-object-released-p DbxDoc) (vlax-release-object DbxDoc)))
Thanks.

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Update block definition from block inside external DWG
« Reply #22 on: April 04, 2018, 01:07:13 PM »
@Marc'Antonio Alessi:
I am not sure if this qualifies as a negative effect but your code will update a block definition for every insert it encounters. If the main block "A" contains 10 inserts "B", the "B" block definition will be updated 10 times. To make the code more efficient consider using some sort of doneBlockNameList.
Or work with a blockNameList and an index. For every insert check if the name is already part of the blockNameList, if not append it. And just work through the list while raising the index.
Code modified to avoid multiple updates.

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Update block definition from block inside external DWG
« Reply #23 on: April 04, 2018, 02:03:56 PM »
Here is my attempt (with a fix for the KGA_Block_DrawOrder function):
Code: [Select]
(defun KGA_Conv_Collection_To_List (coll / ret)
  (reverse
    (vlax-for a coll
      (setq ret (cons a ret))
    )
  )
)

(defun KGA_Sys_Apply (expr varLst / ret)
  (if (not (vl-catch-all-error-p (setq ret (vl-catch-all-apply expr varLst))))
    ret
  )
)

;;; ======================================================================
;;; Lib function: KGA_Block_Update
;;; Purpose:      Update a block definition by importing it from a different document.
;;;               All referenced 'nested' blocks are also updated.
;;; Arguments:    srcDocObj - Source document object.
;;;               trgDocObj - Target document object.
;;;               nme       - Block name.
;;; Return value: Updated main block definition object.
;;; Remarks:      The srcDocObj and the trgDocObj must be different objects.
;;;               Either or both can be ODBX documents.
;;; Examples:
;;; (setq odbxSrc (KGA_Sys_ImportOpen "C:\\Downloads\\Foo.dwg"))
;;; (setq odbxTrg (KGA_Sys_ImportOpen "C:\\Downloads\\Main.dwg"))
;;; (setq obj (KGA_Block_Update odbxSrc odbxTrg "MyBlockAbc"))
;;; (vla-saveas odbxTrg "C:\\Downloads\\MainNew.dwg")
;;; (KGA_Sys_Release odbxSrc)
;;; (KGA_Sys_Release odbxTrg)
;;; ======================================================================
(defun KGA_Block_Update (srcDocObj trgDocObj nme / N_Clone N_UpdateToDo idx mainDef resLst srcBlksObj toDoLst trgBlksObj trgOldNmeLst)

  (defun N_Clone (nme / srcBlkObj srcBlkObjLst trgBlkObj)
    (if
      (and
        (setq srcBlkObj (KGA_Sys_Apply 'vla-item (list srcBlksObj nme)))
        (= :vlax-false (vla-get-isxref srcBlkObj))
        (or
          (not (setq trgBlkObj (KGA_Sys_Apply 'vla-item (list trgBlksObj nme))))
          (= :vlax-false (vla-get-isxref trgBlkObj))
        )
        (setq trgBlkObj ; This will create a new empty block even if nme already exists.
          (KGA_Sys_Apply 'vlax-invoke (list trgBlksObj 'add (vlax-get srcBlkObj 'origin) nme))
        )
      )
      (progn
        ;; Copy other properties:
        (mapcar
          '(lambda (prop) (vlax-put trgBlkObj prop (vlax-get srcBlkObj prop)))
          '(blockscaling comments explodable units) ; Not the path property.
        )
        ;; Copy entities:
        (vlax-invoke srcDocObj 'copyobjects (setq srcBlkObjLst (KGA_Conv_Collection_To_List srcBlkObj)) trgBlkObj)
        ;; Copy draworder (required because the CopyObjects method fails to clone this):
        (KGA_Block_DrawOrderClone srcBlkObj trgBlkObj)
        (list trgBlkObj srcBlkObjLst)
      )
    )
  )

  (defun N_UpdateToDo (srcBlkObjLst / nme)
    (foreach obj srcBlkObjLst
      (if
        (and
          (= "AcDbBlockReference" (vla-get-objectname obj))
          (setq nme (vla-get-name obj))
          (/= "*" (substr nme 1 1))
          (vl-position (strcase nme) trgOldNmeLst)
          (not (assoc (strcase nme) toDoLst))
        )
        (setq toDoLst (append toDoLst (list (cons (strcase nme) nme))))
      )
    )
  )

  (if
    (and
      srcDocObj
      trgDocObj
      (not (equal srcDocObj trgDocObj))
      (setq srcBlksObj (vla-get-blocks srcDocObj)) ; Nil if ODBX doc has been released.
      (setq trgBlksObj (vla-get-blocks trgDocObj)) ; Idem.
    )
    (progn
      (setq trgOldNmeLst
        (mapcar
          '(lambda (obj) (strcase (vla-get-name obj)))
          (KGA_Conv_Collection_To_List trgBlksObj)
        )
      )
      (setq toDoLst (list (cons (strcase nme) nme)))
      (setq idx -1)
      (while (< (setq idx (1+ idx)) (length toDoLst))
        (if (setq resLst (N_Clone (cdr (nth idx toDoLst))))
          (progn
            (if (not mainDef) (setq mainDef (car resLst)))
            (N_UpdateToDo (cadr resLst))
          )
        )
      )
      mainDef
    )
  )
)

; Return value: List of objects. Last object is the top of the draworder.
(defun KGA_Block_DrawOrder (blkObj / sort sortTblObj)
  (if
    (and
      (= :vlax-true (vla-get-hasextensiondictionary blkObj))
      ; Using (vla-getobject) would still require the use of (KGA_Sys_Apply):
      (setq sortTblObj (KGA_Sys_Apply 'vla-item (list (vla-getextensiondictionary blkObj) "ACAD_SORTENTS")))
    )
    (progn
      (vla-getfulldraworder sortTblObj 'sort :vlax-false)
      (setq sort (vlax-safearray->list sort))
      (if (= 'variant (type (car sort)))
        (mapcar 'vlax-variant-value sort) ; BricsCAD.
        sort ; AutoCAD
      )
    )
  )
)

; The function assumes that trgBlkObj has been cloned from srcBlkObj and
; that trgBlkObj does not have a draworder.
; Return value: T or nil.
(defun KGA_Block_DrawOrderClone (srcBlkObj trgBlkObj / srcSortObjLst transLst)
  (if (setq srcSortObjLst (KGA_Block_DrawOrder srcBlkObj))
    (progn
      (setq transLst (mapcar 'cons (KGA_Conv_Collection_To_List srcBlkObj) (KGA_Conv_Collection_To_List trgBlkObj)))
      (vlax-invoke
        (vla-addobject (vla-getextensiondictionary trgBlkObj) "ACAD_SORTENTS" "AcDbSortentsTable")
        'setrelativedraworder
        (mapcar '(lambda (obj) (cdr (assoc obj transLst))) srcSortObjLst)
      )
      T
    )
  )
)

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Update block definition from block inside external DWG
« Reply #24 on: April 04, 2018, 04:27:24 PM »
Here is my attempt (with a fix for the KGA_Block_DrawOrder function):
KGA_Sys_ImportOpen KGA_Sys_Release are missing so I tested with:
Code: [Select]
(setq FilNam "Z:\\Temp\\foo.dwg")
(setq   odbxSrc (vla-GetInterfaceObject *AcadApp* (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
(setq   ErrFlg (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list odbxSrc FilNam))))
(setq odbxTrg (vla-get-activedocument (vlax-get-acad-object)))
(setq obj (KGA_Block_Update odbxSrc odbxTrg "MyBlockAbc"))
(and odbxSrc (or (vlax-object-released-p odbxSrc) (vlax-release-object odbxSrc)))
Very strange in BricsCAD all seems ok,
in AutoCAD I get a strange result (see image) the resulting block is not selectable if touched in some parts, it must be copied, moved or reinserted... so that it regenerates.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Update block definition from block inside external DWG
« Reply #25 on: April 04, 2018, 05:27:22 PM »
Code: [Select]
< ... >
        (setq trgBlkObj ; This will create a new empty block even if nme already exists.
          (KGA_Sys_Apply 'vlax-invoke (list trgBlksObj 'add (vlax-get srcBlkObj 'origin) nme))
        )
< ... >

FYI, in AutoCAD, a call to the Add method of a Collection will return the existing item if present, it will not create a new item to replace the existing.
« Last Edit: April 05, 2018, 08:20:43 AM by Lee Mac »

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Update block definition from block inside external DWG
« Reply #26 on: April 05, 2018, 04:38:27 AM »
FYI, in AutoCAD, a call to Add method of a Collection will return the existing item if present, it not create a new item to replace the existing.
Thanks Lee!

Revised code (fingers crossed...):
Code: [Select]
(defun KGA_Conv_Collection_To_List (coll / ret)
  (reverse
    (vlax-for a coll
      (setq ret (cons a ret))
    )
  )
)

(defun KGA_Sys_Apply (expr varLst / ret)
  (if (not (vl-catch-all-error-p (setq ret (vl-catch-all-apply expr varLst))))
    ret
  )
)

;;; ======================================================================
;;; Lib function: KGA_Block_Update
;;; Purpose:      Update a block definition by importing it from a different document.
;;;               All referenced 'nested' blocks are also updated.
;;; Arguments:    srcDocObj - Source document object.
;;;               trgDocObj - Target document object.
;;;               nme       - Block name.
;;; Return value: Updated main block definition object.
;;; Remarks:      The srcDocObj and the trgDocObj must be different objects.
;;;               Either or both can be ODBX documents.
;;; Examples:
;;; (setq odbxSrc (KGA_Sys_ImportOpen "C:\\Downloads\\Foo.dwg"))
;;; (setq odbxTrg (KGA_Sys_ImportOpen "C:\\Downloads\\Main.dwg"))
;;; (setq obj (KGA_Block_Update odbxSrc odbxTrg "MyBlockAbc"))
;;; (vla-saveas odbxTrg "C:\\Downloads\\MainNew.dwg")
;;; (KGA_Sys_Release odbxSrc)
;;; (KGA_Sys_Release odbxTrg)
;;; ======================================================================
(defun KGA_Block_Update (srcDocObj trgDocObj nme / N_Clone N_UpdateToDo idx mainDef resLst srcBlksObj toDoLst trgBlksObj trgOldNmeLst)

  (defun N_Clone (nme / srcBlkObj srcBlkObjLst trgBlkObj)
    (if
      (and
        (setq srcBlkObj (KGA_Sys_Apply 'vla-item (list srcBlksObj nme)))
        (= :vlax-false (vla-get-isxref srcBlkObj))
        (setq trgBlkObj
          (cond
            ((KGA_Sys_Apply 'vla-item (list trgBlksObj nme)))
            ((KGA_Sys_Apply 'vlax-invoke (list trgBlksObj 'add '(0.0 0.0 0.0) nme)))
          )
        )
        (= :vlax-false (vla-get-isxref trgBlkObj))
      )
      (progn
        ;; Delete entities:
        (mapcar 'vla-delete (KGA_Conv_Collection_To_List trgBlkObj))
        ;; Copy entities:
        (vlax-invoke srcDocObj 'copyobjects (setq srcBlkObjLst (KGA_Conv_Collection_To_List srcBlkObj)) trgBlkObj)
        ;; Copy properties:
        (mapcar
          '(lambda (prop) (vlax-put trgBlkObj prop (vlax-get srcBlkObj prop)))
          '(blockscaling comments explodable origin units) ; Not the path property.
        )
        ;; Copy draworder (required because the CopyObjects method fails to clone this):
        (KGA_Block_DrawOrderClone srcBlkObj trgBlkObj)
        (list trgBlkObj srcBlkObjLst)
      )
    )
  )

  (defun N_UpdateToDo (srcBlkObjLst / nme)
    (foreach obj srcBlkObjLst
      (if
        (and
          (= "AcDbBlockReference" (vla-get-objectname obj))
          (setq nme (vla-get-name obj))
          (/= "*" (substr nme 1 1))
          (vl-position (strcase nme) trgOldNmeLst)
          (not (assoc (strcase nme) toDoLst))
        )
        (setq toDoLst (append toDoLst (list (cons (strcase nme) nme))))
      )
    )
  )

  (if
    (and
      srcDocObj
      trgDocObj
      (not (equal srcDocObj trgDocObj))
      (setq srcBlksObj (vla-get-blocks srcDocObj)) ; Nil if ODBX doc has been released.
      (setq trgBlksObj (vla-get-blocks trgDocObj)) ; Idem.
    )
    (progn
      (setq trgOldNmeLst
        (mapcar
          '(lambda (obj) (strcase (vla-get-name obj)))
          (KGA_Conv_Collection_To_List trgBlksObj)
        )
      )
      (setq toDoLst (list (cons (strcase nme) nme)))
      (setq idx -1)
      (while (< (setq idx (1+ idx)) (length toDoLst))
        (if (setq resLst (N_Clone (cdr (nth idx toDoLst))))
          (progn
            (if (not mainDef) (setq mainDef (car resLst)))
            (N_UpdateToDo (cadr resLst))
          )
        )
      )
      mainDef
    )
  )
)

; Return value: List of objects. Last object is the top of the draworder.
(defun KGA_Block_DrawOrder (blkObj / sort sortTblObj)
  (if
    (and
      (= :vlax-true (vla-get-hasextensiondictionary blkObj))
      ; Using (vla-getobject) would still require the use of (KGA_Sys_Apply):
      (setq sortTblObj (KGA_Sys_Apply 'vla-item (list (vla-getextensiondictionary blkObj) "ACAD_SORTENTS")))
    )
    (progn
      (vla-getfulldraworder sortTblObj 'sort :vlax-false)
      (setq sort (vlax-safearray->list sort))
      (if (= 'variant (type (car sort)))
        (mapcar 'vlax-variant-value sort) ; BricsCAD.
        sort ; AutoCAD
      )
    )
  )
)

; The function assumes that trgBlkObj has been cloned from srcBlkObj and
; that trgBlkObj does not have a draworder.
; Return value: T or nil.
(defun KGA_Block_DrawOrderClone (srcBlkObj trgBlkObj / srcSortObjLst transLst)
  (if (setq srcSortObjLst (KGA_Block_DrawOrder srcBlkObj))
    (progn
      (setq transLst (mapcar 'cons (KGA_Conv_Collection_To_List srcBlkObj) (KGA_Conv_Collection_To_List trgBlkObj)))
      (vlax-invoke
        (vla-addobject (vla-getextensiondictionary trgBlkObj) "ACAD_SORTENTS" "AcDbSortentsTable")
        'setrelativedraworder
        (mapcar '(lambda (obj) (cdr (assoc obj transLst))) srcSortObjLst)
      )
      T
    )
  )
)

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Update block definition from block inside external DWG
« Reply #27 on: April 05, 2018, 04:57:49 AM »
FYI, in AutoCAD, a call to Add method of a Collection will return the existing item if present, it not create a new item to replace the existing.
Thanks Lee!
Revised code (fingers crossed...):
...
Everything seems ok even in AutoCAD.  :) :) :)

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Update block definition from block inside external DWG
« Reply #28 on: April 05, 2018, 08:21:46 AM »
FYI, in AutoCAD, a call to Add method of a Collection will return the existing item if present, it not create a new item to replace the existing.
Thanks Lee!

No worries - I've just corrected my terrible grammar in that post  :uglystupid2:

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Update block definition from block inside external DWG
« Reply #29 on: April 06, 2018, 03:00:58 AM »
Everything seems ok even in AutoCAD.  :) :) :)
Good to hear that. :-D