;;;CADALYST Tips & Tools Weekly 05/01/2006	(c) 2006 Matthew Samario


;;Created by Matthew Samario on 04/25/2006
;;
;;This is an example of how to replace one titleblock block with
;;another titleblock block where both titleblocks have attributes.
;;To run type GetOldTitleblockData to get old attrib values and then
;; type AddNewTitleblockData to delete old block and insert new block with same attrib values.
;;
;;
;;There are 5 main steps involved:
;;First, get old attribute data, insertion point, titleblock scale & rotation.
;;Second, assign all the attribute textstring values to variables.
;;Third, delete & purge old titleblock.
;;Fourth, insert new titleblock
;;Fifth, transfer variables to the new attributes in the new titleblock.
;;
;;First we must grab all the attribute's textstring from the old tittleblock and assign them to variables.
;;This example uses a simple titleblock with 5 attributes. Each attribute is used for different titleblock data.
;;One for drawing name, drawing sheet number, drafter, date, & issue/version number.
;;
;;Xblock3, XblockInsertionPoint1 XScaleX XScaleY XScaleZ XRotation1 will be global variables.
(defun c:GetOldTitleblockData (/ Xblock1 Xblock2 XAttrib1 AllAttribs1 EachAttrib1 EachAttribTagValue1)

    (setq Xblock1 (ssget "X" (list (cons 2 "XTITLEBLOCK"))) ;;grabs your old titleblock block object. Block name is XTITLEBLOCK
            Xblock2 (ssname Xblock1 0)
            Xblock3 (vlax-ename->vla-object Xblock2)
            XblockInsertionPoint1 (vla-get-insertionpoint Xblock3)
            XScaleX (vla-get-xscalefactor Xblock3)                               
            XScaleY (vla-get-yscalefactor Xblock3)
            XScaleZ (vla-get-zscalefactor Xblock3)
            XRotation1 (vla-get-rotation Xblock3)
            XAttrib1 (vla-getattributes Xblock3)
            AllAttribs1 (vlax-safearray->list (vlax-variant-value XAttrib1)) ;;converts variant to safearray & then to a list
            EachAttrib1 (car AllAttribs1))
    (while EachAttrib1                                                                   ;;while statement is used to process thru all attribs
             (setq EachAttribTagValue1 (vla-get-tagstring EachAttrib1))
             (AssignExistAttribToVariable)                                          ;;this subroutine will assign each attrib textstring to a unique variable
             (setq AllAttribs1 (cdr AllAttribs1)
                     EachAttrib1 (car AllAttribs1))
    )
)



;;This subroutine assigns the attrib textstring to a variable 
;;using the cond statement. 
;;
;;DwgName01, DwgShtNumber01, DrafterName01, Date01, IssueNumber01 will be global variables.
(defun AssignExistAttribToVariable ()
    (cond ((= EachAttribTagValue1 "DWGNAME")
                              (setq DwgName01 (vla-get-textstring EachAttrib1))
             )
             ((= EachAttribTagValue1 "DWGSHEETNUMBER")
                              (setq DwgShtNumber01 (vla-get-textstring EachAttrib1))
             )
             ((= EachAttribTagValue1 "DRAFTERNAME")
                              (setq DrafterName01 (vla-get-textstring EachAttrib1))
             )
             ((= EachAttribTagValue1 "DATE")
                              (setq Date01 (vla-get-textstring EachAttrib1))
             )
             ((= EachAttribTagValue1 "ISSUENUMBER")
                              (setq IssueNumber01 (vla-get-textstring EachAttrib1))
             )
    );;close cond
)

;;----------------------------------------------------------------------------------------------------------------------------

;;Now that we have all the attrib textstrings assigned to variables we can transfer the variables to
;;the new block, which will have the same block name, XTITLEBLOCK. But we'll delete and purge out the old 
;;block before inserting the new block so they don't intefere with each other.
;;
(defun c:AddNewTitleblockData (/ AcadDoc AcSpace theLayers Space NEWblock1 NEWblock2 NEWblock3 NEWAttrib1
                                                NEWAllAttribs1 NEWEachAttrib1 NEWEachAttribTagValue1)

    (vla-delete Xblock3)
    (setq AcadDoc (vla-get-activedocument (vlax-get-acad-object))
            theLayers (vla-get-layers AcadDoc))
    (vla-put-activelayer acadDoc (vla-item theLayers 0))                     ;;change this so it makes your desired layer active before inserting new titleblock
    (vla-purgeall Acaddoc)                                                               ;;purges entire active document
    (setq AcSpace (vla-get-activespace AcadDoc))
    (if (= AcSpace 0)
       (progn (setq Space (vlax-get-property AcadDoc 'Paperspace)))
       (progn (setq Space (vlax-get-property AcadDoc 'Modelspace)))
    )
    (vlax-invoke-method Space 'insertblock XblockInsertionPoint1 "C:\\XTITLEBLOCK.dwg" XScaleX XScaleY XScaleZ XRotation1)
    (setq NEWblock1 (ssget "X" (list (cons 2 "XTITLEBLOCK")))
            NEWblock2 (ssname NEWblock1 0)
            NEWblock3 (vlax-ename->vla-object NEWblock2)
            NEWAttrib1 (vla-getattributes NEWblock3)
            NEWAllAttribs1 (vlax-safearray->list (vlax-variant-value NEWAttrib1)) ;;converts variant to safearray & then to a list
            NEWEachAttrib1 (car NEWAllAttribs1))
    (while NEWEachAttrib1                                                                        ;;while statement is used to process thru all attribs
             (setq NEWEachAttribTagValue1 (vla-get-tagstring NEWEachAttrib1))
             (TransferVariablesToNewAttribs)                                                      ;;this subroutine will update each attrib textstring from the variables
             (setq NEWAllAttribs1 (cdr NEWAllAttribs1)
                     NEWEachAttrib1 (car NEWAllAttribs1))
    )
    (vlax-release-object Xblock3)
    (vlax-release-object NEWblock3)
    (vlax-release-object theLayers)
    (vlax-release-object Space)
    (vlax-release-object AcadDoc)

)

;;This subroutine assigns variables to the appropriate attribs using the cond statement. 
;;If the new block has different atttrib tag names than the old titleblock, adjust as necessary.
;;This can also be adjsuted of the number of attribs are different from the old titleblock and the new titleblock.
;;For example, leave some of these attribs off if the new titleblock has fewer attribs. Or maybe have this
;;subroutine read from a txt, csv, xls file to get additional new attrib values.
;;
(defun TransferVariablesToNewAttribs ()
    (cond ((= NEWEachAttribTagValue1 "DWGNAME")
                              (vla-put-textstring NEWEachAttrib1 Dwgname01)
             )
             ((= NEWEachAttribTagValue1 "DWGSHEETNUMBER")
                              (vla-put-textstring NEWEachAttrib1 DwgShtNumber01)
             )
             ((= NEWEachAttribTagValue1 "DRAFTERNAME")
                              (vla-put-textstring NEWEachAttrib1 DrafterName01)
             )
             ((= NEWEachAttribTagValue1 "DATE")
                              (vla-put-textstring NEWEachAttrib1 Date01)
             )
             ((= NEWEachAttribTagValue1 "ISSUENUMBER")
                              (vla-put-textstring NEWEachAttrib1 IssueNumber01)
             )
    );;close cond
)