Topic: Code doesn't seem to update nested blocks like it should

[T.Willey]

So this is starting to get bad.  I'm trying to help someone who doesn't know Lisp, and they keep adding items to the list of things they want the lisp to do.  If it's simple I add, and I thought this one was.  The lisp is the one posted in the show your stuff, where you select blocks you want to redefine by a master library drawings definition of said block.  It will search to see if the block has any nested blocks, and if so, it will update those definitions also.  At least it is supposed to, and the code says it does ( to show you can uncomment out the items in read in the code below ).  The main problem that was brought to me was that nested block items Linetypes were not being copied.  So I put in the commented part to see if they were or not, and they were, but the drawing does not reflect that.  I have tried many things, and have not come up with a way that works.  I am now wanting to figure it  out for my own sanity.

Any help is appreciated.  I can post two drawings if neccary, but to show what is wrong, create a rectangle change it to hidden.  Make that rectangle a block, then make that block into another block.  Save that drawing as 'c:\test\block.dwg'.  Close that drawing.  In a new drawing do the same thing except don't make the first rectangle hidden, but name all the blocks the same.  The code will say that it updated it, but it will not reflect the hidden linetype.

Now for the code

Code: [Select]

(defun c:UpdateBlock (/ BlkDwgPath dbxApp oVer bDidError ActDoc BlkCol fromBlkCol cnt ss Ent EntData BlkName
    BlkDef BlkNameObjList *error* GetBlockDefinitionObjects)
   
    (defun *error* (msg)
       
        (if fromBlkCol (vlax-release-object fromBlkCol))
        (if dbxApp (vlax-release-object dbxApp))
        (setq fromBlkCol nil)
        (setq dbxApp nil)
        (if msg (prompt (strcat "\n Error-> " msg)))
    )
    ;---------------------------------------------
    (defun GetBlockDefinitionObjects (BlkCol BlkName BlkNameObjList / ObjList tempName)
       
        (if (not (vl-catch-all-error-p (setq BlkDef (vl-catch-all-apply 'vla-Item (list BlkCol BlkName)))))
            (vlax-for obj BlkDef
                (if
                    (and
                        (= (vla-get-ObjectName obj) "AcDbBlockReference")
                        (not (assoc (setq tempName (vla-get-Name obj)) BlkNameObjList))
                    )
                    (setq BlkNameObjList (GetBlockDefinitionObjects BlkCol tempName BlkNameObjList))
                )
                (setq ObjList (cons obj ObjList))
            )
        )
        (if ObjList
            (setq BlkNameObjList (cons (cons BlkName ObjList) BlkNameObjList))
        )
        BlkNameObjList
    )
    ;-----------------------------------------------------------------
    (setq BlkDwgPath "c:/test/Block.dwg")
   
    (setq dbxApp
        (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
            (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
            (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
        )
    )
    (setq bDidError (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp BlkDwgPath))))
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (setq BlkCol (vla-get-Blocks ActDoc))
    (setq fromBlkCol (vla-get-Blocks dbxApp))
    (setq cnt -1)
    (if
        (and
            (not bDidError)
            (setq ss (ssget '((0 . "INSERT"))))
        )
        (while (setq Ent (ssname ss (setq cnt (1+ cnt))))
            (setq EntData (entget Ent))
            (setq BlkName (cdr (assoc 2 EntData)))
            (if (not (assoc BlkName BlkNameObjList))
                (setq BlkNameObjList (GetBlockDefinitionObjects fromBlkCol BlkName BlkNameObjList))
            )
        )
    )
    (foreach lst (reverse BlkNameObjList)
        (if (not (vl-catch-all-error-p (setq BlkDef (vl-catch-all-apply 'vla-Item (list BlkCol BlkName)))))
            (progn
                (vlax-for obj BlkDef
                    (vla-Delete obj)
                )
                (vlax-invoke dbxApp 'CopyObjects (cdr lst) BlkDef)
                (prompt (strcat "\n\n Updated block: " (car lst)))
                [color=red];(vlax-for obj BlkDef
                ;    (prompt (strcat "\n " (vla-get-ObjectName obj) " [ " (vla-get-Linetype obj) " ]"))
                ;)[/color]
            )
        )
    )
    (prompt "\n")
    (vla-Regen ActDoc acActiveViewport)
    (*error* nil)
    (princ)
)


Updated block: nested
 AcDbPolyline [ HIDDEN ]

 Updated block: main
 AcDbBlockReference [ BYLAYER ]

[CAB]

I'm too tired to think clearly, heading off to saw some logs.
But perhaps the (vla-Delete obj) is not deleting the block because it is nested and therefore the copy also fails
because the object exist.

[T.Willey]

I'm too tired to think clearly, heading off to saw some logs.
But perhaps the (vla-Delete obj) is not deleting the block because it is nested and therefore the copy also fails
because the object exist.

The code finds all the blocks that its going to redefine first, and makes a list.  It then find the current definition and deletes all the objects so that when it redefines it, it only has the new objects.

[CAB]

Good morning Tim.
I just ran the routine with this line  commented out:
(vlax-invoke dbxApp 'CopyObjects (cdr lst) BlkDef)

The result was the nested block definition still existed in the drawing although the INSERT of that block was gone.
The combined block name was still visible in the INSERT dialog but the insert and the definition seemed to be deleted.
What results do you get when trying this?

[CAB]

Found it.
The BlkName was not being updated.

Code: [Select]

    (foreach lst (reverse BlkNameObjList)
        (setq BlkName (car lst))  ;  <----<< Needs This Line

[T.Willey]

Found it.
The BlkName was not being updated.

Code: [Select]

    (foreach lst (reverse BlkNameObjList)
        (setq BlkName (car lst))  ;  <----<< Needs This Line

Alan!!!  You are my hero.

Guess you sometimes miss the trees in the forest.  I knew it had to be something simple.  Here is the code.

Thank you sir.

Code: [Select]

(defun c:UpdateBlock (/ BlkDwgPath dbxApp oVer bDidError ActDoc BlkCol fromBlkCol cnt ss Ent EntData BlkName
    BlkDef BlkNameObjList *error* GetBlockDefinitionObjects)
   
    (defun *error* (msg)
       
        (if fromBlkCol (vlax-release-object fromBlkCol))
        (if dbxApp (vlax-release-object dbxApp))
        (setq fromBlkCol nil)
        (setq dbxApp nil)
        (if msg (prompt (strcat "\n Error-> " msg)))
    )
    ;---------------------------------------------
    (defun GetBlockDefinitionObjects (BlkCol BlkName BlkNameObjList / ObjList tempName)
       
        (if (not (vl-catch-all-error-p (setq BlkDef (vl-catch-all-apply 'vla-Item (list BlkCol BlkName)))))
            (vlax-for obj BlkDef
                (if
                    (and
                        (= (vla-get-ObjectName obj) "AcDbBlockReference")
                        (not (assoc (setq tempName (vla-get-Name obj)) BlkNameObjList))
                    )
                    (setq BlkNameObjList (GetBlockDefinitionObjects BlkCol tempName BlkNameObjList))
                )
                (setq ObjList (cons obj ObjList))
            )
        )
        (if ObjList
            (setq BlkNameObjList (cons (cons BlkName ObjList) BlkNameObjList))
        )
        BlkNameObjList
    )
    ;-----------------------------------------------------------------
    (setq BlkDwgPath "c:/test/Block.dwg")
   
    (setq dbxApp
        (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
            (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
            (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
        )
    )
    (setq bDidError (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp BlkDwgPath))))
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (setq BlkCol (vla-get-Blocks ActDoc))
    (setq fromBlkCol (vla-get-Blocks dbxApp))
    (setq cnt -1)
    (if
        (and
            (not bDidError)
            (setq ss (ssget '((0 . "INSERT"))))
        )
        (while (setq Ent (ssname ss (setq cnt (1+ cnt))))
            (setq EntData (entget Ent))
            (setq BlkName (cdr (assoc 2 EntData)))
            (if (not (assoc BlkName BlkNameObjList))
                (setq BlkNameObjList (GetBlockDefinitionObjects fromBlkCol BlkName BlkNameObjList))
            )
        )
    )
    (foreach lst (reverse BlkNameObjList)
        [color=red](if (not (vl-catch-all-error-p (setq BlkDef (vl-catch-all-apply 'vla-Item (list BlkCol (car lst))))))[/color]
            (progn
                (vlax-for obj BlkDef
                    (vla-Delete obj)
                )
                (vlax-invoke dbxApp 'CopyObjects (cdr lst) BlkDef)
                (prompt (strcat "\n\n Updated block: " (car lst)))
                ;(vlax-for obj BlkDef
                ;    (prompt (strcat "\n " (vla-get-ObjectName obj) " [ " (vla-get-Linetype obj) " ]"))
                ;)
            )
        )
    )
    (prompt "\n")
    (vla-Regen ActDoc acActiveViewport)
    (*error* nil)
    (princ)
)


[CAB]

Yea, it's often the little things that give you the most trouble.
You're quite welcome.