TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Marc'Antonio Alessi on March 23, 2018, 02:00:46 PM

Title: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 23, 2018, 02:00:46 PM
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
Title: Re: Update block definition from block inside external DWG
Post by: HasanCAD on March 26, 2018, 03:50:46 AM
Subroutines not included
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 26, 2018, 06:11:22 AM
Subroutines not included
I know... it is only an example, there are many sub to post and not needed for the question..
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 26, 2018, 08:12:17 AM
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)
)
Title: Re: Update block definition from block inside external DWG
Post by: MP on March 26, 2018, 09:16:06 AM
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.
Title: Re: Update block definition from block inside external DWG
Post by: MP on March 26, 2018, 02:39:14 PM
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.
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 26, 2018, 03:19:12 PM
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. ^-^
Title: Re: Update block definition from block inside external DWG
Post by: roy_043 on March 26, 2018, 05:12:18 PM
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.
Title: Re: Update block definition from block inside external DWG
Post by: MP on March 26, 2018, 06:50:15 PM
(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 (http://www.bit.ly/2I4GHQt).
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 27, 2018, 04:38:52 AM
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.  :embarrassed:

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...
Title: Re: Update block definition from block inside external DWG
Post by: roy_043 on March 27, 2018, 04:41:53 AM
@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. :-D
Title: Re: Update block definition from block inside external DWG
Post by: MP on March 27, 2018, 08:45:20 AM
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.
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 27, 2018, 09:09:44 AM
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.
Title: Re: Update block definition from block inside external DWG
Post by: MP on March 27, 2018, 09:56:28 AM
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.
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 27, 2018, 10:12:12 AM
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... 8-)
Grazie.  :-)
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi 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
)
Title: Re: Update block definition from block inside external DWG
Post by: roy_043 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.
Title: Re: Update block definition from block inside external DWG
Post by: roy_043 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
    )
  )
)
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 28, 2018, 07:13:41 AM
I'll look at your code in 3 days, only SmartF. now.  :-)
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi 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
Title: Re: Update block definition from block inside external DWG
Post by: roy_043 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.
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi 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.
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi 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.
Title: Re: Update block definition from block inside external DWG
Post by: roy_043 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
    )
  )
)
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi 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.
Title: Re: Update block definition from block inside external DWG
Post by: Lee Mac 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.
Title: Re: Update block definition from block inside external DWG
Post by: roy_043 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
    )
  )
)
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi 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.  :) :) :)
Title: Re: Update block definition from block inside external DWG
Post by: Lee Mac 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:
Title: Re: Update block definition from block inside external DWG
Post by: roy_043 on April 06, 2018, 03:00:58 AM
Everything seems ok even in AutoCAD.  :) :) :)
Good to hear that. :-D
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on April 07, 2018, 05:09:09 AM
Everything seems ok even in AutoCAD.  :) :) :)
Good to hear that. :-D
From the number of visits I think your work has been much appreciated, thanks again.  :-)
Title: Re: Update block definition from block inside external DWG
Post by: MrSmith on March 17, 2021, 10:46:51 PM
Just a heads up, you are using global variables not defined in the code which may cause people confusion.

*AcadApp* = (vlax-get-acad-object)
*AcAcDwg* = (vla-get-ActiveDocument (vlax-get-acad-object))

Otherwise, my initial tests looked very promising. Going to use it to create a DCL for some mass block redefining.  :-D
Thanks everyone who contributed!
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 18, 2021, 05:12:24 AM
Just a heads up, you are using global variables not defined in the code which may cause people confusion.

*AcadApp* = (vlax-get-acad-object)
*AcAcDwg* = (vla-get-ActiveDocument (vlax-get-acad-object))

Otherwise, my initial tests looked very promising. Going to use it to create a DCL for some mass block redefining.  ;D
Thanks everyone who contributed!
>>> you are using global variables not defined in the code which may cause people confusion  Where?
Title: Re: Update block definition from block inside external DWG
Post by: MrSmith on March 18, 2021, 12:17:06 PM
Post #15, "Function: ALE_Block_UpdByBlkInFile, Version 1.02 - 2018/04/04..." used the variables I mentioned above.
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 19, 2021, 10:14:27 AM
Post #15, "Function: ALE_Block_UpdByBlkInFile, Version 1.02 - 2018/04/04..." used the variables I mentioned above.
Yes  :yes: you are correct, code updated:

(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
Title: Re: Update block definition from block inside external DWG
Post by: MrSmith on March 19, 2021, 04:00:40 PM
Awesome! On a different note, do you know how to handle attribute blocks? It looks like they don't get sync properly without an ATTSYNC command.

I've looked through various threads like:
https://www.theswamp.org/index.php?topic=52255.msg572293#msg572293
https://www.theswamp.org/index.php?topic=52209.0

Seems like it is a bug on AutoCAD's side? Vla-update on either the block object or the attribute object didn't work.
Title: Re: Update block definition from block inside external DWG
Post by: MrSmith on March 19, 2021, 08:58:45 PM
For what is worth, I played around with it to allow for processing a list of blocks. It also allows you to have the documents open.

I still couldn't figure out how to sync attributes. Also noticed it doesn't work well with dynamic blocks either. The Design Center "Redefine" also doesn't seem to work well with them either, though it does a slightly better job with dynamic blocks that have the same anonymous name. I am guessing it looks at both when it redefines them.

I plan on writing a DCL later on which I may post.

Code - Auto/Visual Lisp: [Select]
  1. ;RedefineBlocks => By MrSmith 3/19/2021
  2. ;Support functions mostly by Lee Mac
  3. ;Redefine Block functionality mostly from https://www.theswamp.org/index.php?topic=54041.msg586836#msg586836
  4.  
  5. ;NOTE: Function does not work well with Attribute Blocks or Dynamic Blocks.
  6.  
  7. ;############EXAMPLE FUNCTION############
  8. ;Change blockNameList, newBlockLocation, and oldBlockLocation
  9. (defun c:RedefineBlocks ( / blockNameList newBlockLocation oldBlockLocation DbxDocNew DbxDocOld blocksInfo)
  10.    (setq blockNameList (list "TestBlock1" "TestBlock2")) ;List of block names to be updated
  11.    (setq newBlockLocation "C:\\Test Land\\Redefine Blocks\\0.dwg") ;Set this to the drawing path of most updated blocks
  12.    (setq oldBlockLocation "C:\\Test Land\\Redefine Blocks\\1.dwg") ;Set this to the drawing to update blocks inside
  13.    (setq DbxDocNew (setDBXDocument newBlockLocation))
  14.    (setq DbxDocOld (setDBXDocument oldBlockLocation))
  15.    (setq blocksInfo (setSourceBlocks blockNameList DbxDocNew)) ;Get all the blocks information
  16.    (updateOldBlocks blocksInfo DbxDocOld DbxDocNew) ;Update all the blocks with the information
  17.    (vla-regen DbxDocOld acActiveViewport)
  18.    (mapcar 'release (list DbxDocNew DbxDocOld *dbx*))
  19.    (princ "\nUpdate Complete!")
  20.    (princ)
  21. )
  22.  
  23. ;#############MAIN FUNCTIONS#############
  24. ;blockList - list of block names to be redefined
  25. ;sourceDWG - DBX document object containing the location of the updated blocks
  26. (defun setSourceBlocks (blockList sourceDWG / getBlockObjects  BlkLst  sourceBlockLst sourceBlockCol blkData)
  27.    (defun getBlockObjects (blkData / subBlock ObjLst) ;Used to get each entity in a block
  28.       (vlax-for obj blkData ;obj is vla entity of block
  29.          (and
  30.             (= "AcDbBlockReference" (vla-get-ObjectName obj)) ;The object is a Block
  31.             (not (vl-position (setq subBlock (vla-get-EffectiveName obj)) BlkLst)) ;The object does not currently show up in our block list
  32.             (setq BlkLst (cons subBlock BlkLst)) ;Add object to block list, this is to prevent duplicant blocks from being gathered
  33.             (getBlockObjects (_getitem sourceBlockCol subBlock)) ;Get the sub block entities
  34.          )
  35.          (setq ObjLst (cons obj ObjLst)) ;Save the vla object
  36.       )
  37.       (setq sourceBlockLst (cons (cons (vla-get-name blkData) (list ObjLst)) sourceBlockLst))
  38.       ;sourceBlockLst => (list (list "BlockName1" (list vlaObjs...)) (list "BlkName2" (list vlaObjs2...)...))      
  39.    )
  40.    
  41.    (setq sourceBlockCol (vla-get-blocks sourceDWG))
  42.    (foreach block blockList ;Cycle through our list of block names
  43.       (if (setq blkData (_getitem sourceBlockCol block)) ;If it exists in the source drawing
  44.          (getBlockObjects blkData) ;Get its subentities
  45.       )
  46.    )
  47.    sourceBlockLst
  48. )
  49.  
  50. ;BlockListData -- (list (list "BlockName1" (list vlaObjs...)) (list "BlkName2" (list vlaObjs2...)...))
  51. ;OldDBDoc/NewDBDoc - Dbx Documents. Old is the drawing with blocks to be redefined by the new block
  52. (defun updateOldBlocks (blockListData OldDBDoc NewDBDoc / BksColOld oldBlkData)
  53.    (setq BksColOld (vla-get-Blocks OldDBDoc))
  54.    (foreach blockData blockListData
  55.       (if (setq oldBlkData (_getitem BksColOld (car blockData)))
  56.          (progn
  57.             (vlax-for obj oldBlkData (vla-delete obj)) ;Delete the items in the old block
  58.             (vlax-invoke NewDBDoc 'copyobjects (cadr blockData) oldBlkData) ;Copy the new information from source.
  59.             ;Note: Source document MUST be open still per the DbxDocSource
  60.          )
  61.       )
  62.    )
  63. )
  64.  
  65. ;###########SUPPORT FUNCTIONS############
  66. (defun release (obj) (if (= 'vla-object (type obj)) (vlax-release-object obj)))
  67.  
  68. (defun _getitem ( col itm )
  69.    (if (not (vl-catch-all-error-p (setq itm (vl-catch-all-apply 'vla-item (list col itm)))))
  70.       itm
  71.    )
  72. )
  73.  
  74. (defun setDBXObject ( / vrs) ;Sets the DBX Object, from Lee
  75.    (if (or (not *dbx*) (= 'vla-object (type *dbx*)))
  76.       (setq *dbx* (vl-catch-all-apply 'vla-getinterfaceobject
  77.          (list (setq *acad* (vlax-get-acad-object))
  78.             (if (< (setq vrs (atoi (getvar 'acadver))) 16) "objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs)))))
  79.       )
  80.    )
  81.    (if (or (null *dbx*) (vl-catch-all-error-p *dbx*)) (notifyExit "\nUnable to interface with ObjectDBX."))
  82. )
  83.  
  84. (defun setDBXDocument (dwgPath / dwl DbDocument)
  85.    ;Set our *dbx* Object
  86.    (setDBXObject)
  87.    (vlax-for doc (vla-get-documents *acad*)
  88.       (setq dwl (cons (cons (strcase (vla-get-fullname doc)) doc) dwl)) ;Used to make sure we are not opening already open drawings
  89.    )
  90.    (if
  91.       (or (setq DbDocument (cdr (assoc (strcase dwgPath) dwl))) ;Already Opened File, set doc to it
  92.          (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list *dbx* dwgPath)))) ;Else, open the drawing via dbx
  93.             (setq DbDocument *dbx*) ;Set doc as the DBX object
  94.          )
  95.       )
  96.       DbDocument
  97.       (progn
  98.          (princ (strcat "\nUnable to interface with Drawing: " (cadr (fnsplitl dwgPath)) "). Drawing may be open!"))
  99.          nil
  100.       )
  101.    )
  102. )
  103.  
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 20, 2021, 05:12:26 AM
I don't have much time now to go through your code… For attribute blocks I use ATTSYNC:

(setq InfLst (ALE_Block_Cmd_NentselBlock "Seleziona il blocco principale o annidato da aggiornare")) ; see: http://www.theswamp.org/index.php?topic=55966.msg599644#msg599644

(entupd (caddr InfLst)) (and (cadddr InfLst) (entupd (cadddr InfLst)))

(and (= (DXF 66 (cadr InfLst)) 1) (vl-cmdf "_.ATTSYNC" "_NAME" BlkNam))
Title: Re: Update block definition from block inside external DWG
Post by: MrSmith on March 20, 2021, 06:18:37 PM
No worries, I was just sharing in case someone else found it useful. The functionality is identical, as far as I can tell.

As for the attributes, I was afraid that case. Means you can't update it through DBX. Thanks for verifying!

Edit: After thinking about it, couldn't you delete the attribute blocks from the drawing itself and put them back with their correct attributes? My preliminary testing seems promising....
Title: Re: Update block definition from block inside external DWG
Post by: MrSmith on March 21, 2021, 04:28:13 AM
It seems to work.... the biggest problem with it is it deletes the blocks, which may or may not be an issue depending on the circumstance. Somehow, the AttSync command does not delete them.

Code - Auto/Visual Lisp: [Select]
  1. ;SyncAttributeBlocks => By MrSmith 3/21/2021
  2.  
  3. ;NOTE: Lightly tested, use at your own risk. Syncs blocks using VLA functions by deleting and re-inserting the block.
  4. (defun c:SyncAttributeBlocks ( / ssprompt ssList removeDuplicates toVLA blkName setAttributeValues ss)
  5.    ;********SUPPORT FUNCTIONS***********
  6.    (defun ssprompt   (filter msg / ss old)
  7.       (setq old (getvar "nomutt"))
  8.       (setvar "NOMUTT" 0)
  9.       (prompt msg)
  10.       (setvar "NOMUTT" 1)
  11.       (vl-catch-all-apply '(lambda () (setq ss (ssget filter))))
  12.       (setvar "NOMUTT" old)
  13.       ss
  14.    )
  15.    (defun ssList (ss / lst ct)
  16.       (if ss (progn (setq ct 0) (repeat (sslength ss) (setq lst (cons (ssname ss ct) lst) ct (+ ct 1)))))
  17.       lst
  18.    )
  19.    (defun removeDuplicates ( l ) ;; Unique  -  Lee Mac ;; Returns a list with duplicate elements removed.
  20.       (if l (cons (car l) (removeDuplicates (vl-remove (car l) (cdr l)))))
  21.    )
  22.    (defun toVLA (entity / out) ;Protects against errors to convert objects to VLA
  23.       (if (not (vl-catch-all-error-p (setq out (vl-catch-all-apply '(lambda () (vlax-ename->vla-object entity)) nil))))
  24.          out
  25.          nil
  26.       )
  27.    )
  28.    (defun blkName (vlaBlk)
  29.       (if (vlax-property-available-p vlaBlk 'effectivename)
  30.             (vla-get-effectivename vlaBlk)
  31.             (vla-get-name vlaBlk)
  32.       )
  33.    )
  34.    (defun setAttributeValues ( blk lst / itm )
  35.       (mapcar '(lambda (x) (if (setq itm (assoc (vla-get-tagstring x) lst)) (vla-put-textstring x (cdr itm)))) (vlax-invoke blk 'getattributes))
  36.    )
  37.    ;***********MAIN***********
  38.    (if
  39.       (and
  40.          (setq ss (ssPrompt '((0 . "Insert")) "Select Blocks to Sync:"))
  41.          (setq ss (mapcar 'tovla (sslist ss)))
  42.          (setq ss (vl-remove nil (mapcar '(lambda (x) (if (= ':vlax-true (vla-get-hasattributes x)) x nil)) ss)))
  43.          (setq ss (removeDuplicates (mapcar 'strcase (mapcar 'blkName ss))))
  44.       )
  45.       (syncAttributeBlocks ss (vla-get-ActiveDocument (vlax-get-acad-object)))
  46.       (alert "You did not select any attributed blocks to sync!")
  47.    )
  48. )
  49.  
  50. ;Syncs blocks using VLA functions by deleting the block and putting a new one in its place with the same values
  51. ;blockNameList - List of Block Names to Sync
  52. ;dbDoc - AutoCAD document
  53. (defun syncAttributeBlocks (blockNameList dbDoc / blockName atts data new)
  54.    (foreach block blockNameList
  55.       (setq blockName (strcase block))
  56.       (vlax-for la (vla-get-layouts dbDoc)
  57.          (vlax-for o (vla-get-block la) ;o is my vla block
  58.             (if
  59.                (and
  60.                   (= "AcDbBlockReference" (vla-get-objectname o)) ;Make sure o is a block
  61.                   (= :vlax-true (vla-get-hasattributes o)) ;Make sure o (the block) has attributes
  62.                   (= blockName (strcase (blkName o))) ;We found our block
  63.                   (setq data ;Get our block information
  64.                      (mapcar '(lambda (x) (vlax-get-property o x))
  65.                         '(EntityTransparency InsertionPoint Layer Linetype LinetypeScale Lineweight Material Normal PlotStyleName Rotation TrueColor Visible
  66.                            XEffectiveScaleFactor XScaleFactor YEffectiveScaleFactor YScaleFactor ZEffectiveScaleFactor ZScaleFactor
  67.                         )
  68.                      )
  69.                   )
  70.                )
  71.                (progn
  72.                   (foreach att (vlax-invoke o 'getattributes) ;Get Attribute info
  73.                      (setq atts (cons (cons (vla-get-tagstring att) (vla-get-textstring att)) atts))
  74.                   )
  75.                   (vla-delete o) ;Delete old block
  76.                   (setq new (vla-insertblock (vla-get-block la) (vlax-3D-point '(0 0 0)) blockName 1 1 1.0 0)) ;Insert a new block
  77.                   (foreach prop ;Update the new block with old properties
  78.                      '(EntityTransparency InsertionPoint Layer Linetype LinetypeScale Lineweight Material Normal PlotStyleName Rotation TrueColor Visible
  79.                      XEffectiveScaleFactor XScaleFactor YEffectiveScaleFactor YScaleFactor ZEffectiveScaleFactor ZScaleFactor)
  80.                      (vl-catch-all-apply 'vlax-put-property (list new prop (car data)))
  81.                      (setq data (cdr data))
  82.                   )
  83.                   (setAttributeValues new atts) ;Update the new blocks attribute values
  84.                   (mapcar '(lambda (x) (set x nil)) '(atts data new))
  85.                )
  86.             )
  87.          )
  88.       )
  89.    )
  90. )
  91.  
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 21, 2021, 06:32:34 AM
I don't have much time now to make a full function, I have found this piece of code to play with blocks and different number of attribute, it is a 2016 year code I do not remeber to much... maybe can help… Sorry for italian note.
Code: [Select]
;             Block name   Layer name   Layout name
; BksInf  (("TITLEBLOCK"    "LAYERX"    "MODEL"     #<VLA-OBJECT IAcadBlockReference2 08330c34>) (...) ...) ; block list
;
      (setq BksCol (vla-get-blocks DbxDoc))
      (foreach ForElm BksInf
        (setq
          BlkNam (car    ForElm)
          BlkDef (ALE_Utl_GetItem BksCol BlkNam)       ; Obj definizione di blocco
          BkDInP (safearray-value (vlax-variant-value (vla-get-Origin BlkDef)))        ; InsertionPoint definizione di blocco
          BlkIns (cadddr ForElm)                ; Obj blocco inserito
          BlkScl (vla-get-XScaleFactor   BlkIns); scalaX blocco inserito
          BkIInP (safearray-value (vlax-variant-value (vla-get-InsertionPoint BlkIns))); InsertionPoint blocco inserito
          BkIAtt (vlax-invoke BlkIns 'GetAttributes); attributi blocco inserito - se si usa (vla-GetAttributes VlaObj) si ottiene un variant che bisogna trasformare e poi elaborare con vlax-for
        )
        (vlax-for ObjFor BlkDef ; attributi definizione di blocco
          (if (= (vla-get-objectname ObjFor) "AcDbAttributeDefinition")
            (setq BkDAtt (cons (list (vla-get-TagString ObjFor) ObjFor) BkDAtt))
          )
        )
        ; BkIAtt (#<VLA-OBJECT IAcadAttributeReference 000000003ce20898> #<VLA-OBJECT IAcadAttributeReference 000000003ce240d8> ...)
        ; BkDAtt (("FILE" #<VLA-OBJECT IAcadAttribute 000000003da926c8>) ("ACVER" #<VLA-OBJECT IAcadAttribute 000000003da90508>) ...)
        (cond
          ( (> (length BkDAtt) (length BkIAtt))
            (setq
              NewBlk
                (vla-InsertBlock
                  (vla-objectidtoobject DbxDoc (vla-get-ownerid BlkIns)) (vla-get-InsertionPoint BlkIns) (vla-get-Name BlkIns) BlkScl BlkScl BlkScl (vla-get-Rotation BlkIns)
                )
            )
            (vla-put-Layer NewBlk (vla-get-Layer BlkIns))
    (vla-put-Linetype NewBlk (vla-get-Linetype BlkIns))
            (foreach ObjFor BkIAtt ; lista attributi blocco inserito con TAG
              (setq AttLst (cons (list (vla-get-TagString ObjFor) ObjFor) AttLst))
            )
            (foreach ObjFor (vlax-invoke NewBlk 'GetAttributes); attributi NUOVO blocco inserito
              (and
                (setq AttInf (assoc (vla-get-TagString ObjFor) AttLst)) ; se trovo l'attributo nella lista attributi blocco inserito con TAG   
                (vla-Put-textstring ObjFor (vla-get-TextString (cadr AttInf)))
              )
            )
            (vla-Delete BlkIns)
          )
          ( T ; se gli attributi sono uguali o inferiori
            (foreach ObjFor BkIAtt
              (if (setq AttInf (assoc (vla-get-TagString ObjFor) BkDAtt)) ; se trovo l'attributo nella lista degli attributi in definizione di blocco   
                (progn
                  (setq AttObj (cadr AttInf))
                  (vla-put-Alignment ObjFor (vla-get-Alignment AttObj))
                  (vla-put-Layer ObjFor (vla-get-Layer AttObj))
                  (vla-put-Linetype ObjFor (vla-get-Linetype AttObj))
                  (vla-put-ScaleFactor ObjFor (vla-get-ScaleFactor AttObj))
                  (vla-put-StyleName ObjFor (vla-get-StyleName AttObj))
                  (vla-put-Rotation ObjFor (vla-get-Rotation AttObj))
                  (vla-put-Height ObjFor (* BlkScl (vla-get-Height AttObj)))
                  (setq
                    AtDInp (safearray-value (vlax-variant-value (vla-get-InsertionPoint AttObj)))
                    DeltaX (ALE_Attrib_CalcDeltaX BkIInP AtDInp BkDInP BlkScl)
                    DeltaY (ALE_Attrib_CalcDeltaY BkIInP AtDInp BkDInP BlkScl)
                  )
                  (vla-put-InsertionPoint ObjFor (vlax-3D-point (list DeltaX DeltaY 0)))
                  (setq
                    AtDInp (safearray-value (vlax-variant-value (vla-get-TextAlignmentPoint AttObj)))
                    DeltaX (ALE_Attrib_CalcDeltaX BkIInP AtDInp BkDInP BlkScl)
                    DeltaY (ALE_Attrib_CalcDeltaY BkIInP AtDInp BkDInP BlkScl)
                  ); nei testi con acAlignmentLeft la proprietà seguente non è modificabile
                  (vl-catch-all-apply 'vlax-put-property (list ObjFor 'TextAlignmentPoint  (vlax-3D-point (list DeltaX DeltaY 0))))
                );progn
              );if
            );foreach BkIAtt
          )
        );cond
      );foreach BksInf


 
(defun ALE_Attrib_CalcDeltaX (BkIInP AtDInp BkDInP BlkScl)
  (+ (car  BkIInP) (* (- (car  AtDInp) (car  BkDInP)) BlkScl))
)
;
(defun ALE_Attrib_CalcDeltaY (BkIInP AtDInp BkDInP BlkScl)
  (+ (cadr BkIInP) (* (- (cadr AtDInp) (cadr BkDInP)) BlkScl))
)
(defun ALE_Utl_GetItem (VlaCol KeyNam / VlaObj)
  (vl-catch-all-apply
   '(lambda ( )
      (setq VlaObj (vla-item VlaCol KeyNam))
    )
  )
  VlaObj
)
Title: Re: Update block definition from block inside external DWG
Post by: MrSmith on March 21, 2021, 04:15:01 PM
Looks very similar to what I did; however, it went an extra step with positioning the attributes. I'll have to try adding that and playing around with it. I know attributes will move around if they are not left justified and you modify them through DBX. Hopefully it will fix my issue with that.

Thanks!
Title: Re: Update block definition from block inside external DWG
Post by: MrSmith on March 28, 2021, 11:49:08 PM
Hey Marc, finally got a chance to test our the code you posted and it worked really well! Thanks for sharing. It fixed a problem I had with another LISP routine I'd written.  :-)
Title: Re: Update block definition from block inside external DWG
Post by: Marc'Antonio Alessi on March 29, 2021, 08:56:08 AM
Hey Marc, finally got a chance to test our the code you posted and it worked really well! Thanks for sharing. It fixed a problem I had with another LISP routine I'd written.  :)
:)