TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Xander on August 17, 2009, 04:45:16 AM

Title: Update specific block tags
Post by: Xander on August 17, 2009, 04:45:16 AM

I have a small problem.  I have recently been appointed CAD manager for my new workplace and to say the least their titleblock structure is appalling... I have the following structure for attributes:

Tag	Prompt	Value
S-00	Drawing Number	S-01
XXXX	Sheet Title Line 1	Structural Works:
XXXX	Sheet Title Line 2	Concrete Reinforcing Plan

   



What I want to do is logically simple.  A routine (repetitive or not) to identify the block by the name, then update the tag based on the prompt.
In theory I should be able to get the draftsmen to fix their blocks as they come across them without destroying the values already there.

Is it possible???

Title: Re: Update specific block tags
Post by: Lee Mac on August 17, 2009, 04:59:19 AM

You could use BEdit to edit the block definition - then just an attsync to change all the blocks at once.  :-)

Title: Re: Update specific block tags
Post by: Xander on August 17, 2009, 05:16:03 AM

I had completely forgotten about that!  Thanks.

Title: Re: Update specific block tags
Post by: Lee Mac on August 17, 2009, 05:29:48 AM

No problem  :-)

Title: Re: Update specific block tags
Post by: Xander on August 17, 2009, 09:27:52 PM

Lee,

The Bedit, followed by attsync is ok but it strips all my values...  I have attempted to solve this through the following:

Code: [Select]

     (defun BLOCK_TAG_REPLACE (sBlock sNewString sOldPrompt)
        (setq ss1 (ssget "X"(list (cons 0 "INSERT")(cons 2 sBlock)(cons 410(getvar "CTAB")))))
        (setq entname (ssname ss1 0))
        (setq titletext (vlax-ename->vla-object entname))
        (setq attributes (vlax-invoke titletext "GetAttributes"))

        (foreach attrib attributes
          (setq temp (vla-get-PromptString attrib))
          (alert temp)
          (if
            (= (vla-get-PromptString attrib) sOldPrompt)
            (vla-put-TagString attrib sNewString)
          )
        )
      )
      
      (DEFUN C:GTTEST ()
      (BLOCK_TAG_REPLACE "A1-TITLE" "SHT" "Drawing Number")
      )


In manipulating the above, I can easily get it to alter based on the current tag string.  However, with many tags being XXXX it is rather difficult to distinguish them.  

The only problem I am having is obtaining the promptstring... Any suggestions?

Title: Re: Update specific block tags
Post by: Xander on August 18, 2009, 01:46:49 AM

After much struggling and fighting, I've managed to do it!  :evil:

I managed to update the tag within a drawing while only updating one of my block references.  To say the least this confused be alot.  After opening a new drawing, confirming values were the same I discovered the solution.

Code: [Select]

     (defun BLOCK_TAG_REPLACE (sBlock sPrompt sTag / Ent EntName IAcadBlockReference2 BlName AttObjLst IAcadBlock3 PromptString)
        ;Load the Visual list Com
        (vl-load-com)
        ;Locate the specified block name in the current tab
        (if (setq ss1 (ssget "X"(list (cons 0 "INSERT")(cons 2 sBlock)(cons 410(getvar "CTAB")))))
          (progn
            ;set the Entity Name to the first found block
            (setq EntName (ssname ss1 0))
            ;Create a new reference of the block for attributes
            (setq IAcadBlockReference2 (vlax-ename->vla-object EntName ) )
            ;If the block reference has attributes
            (if (= (vla-get-hasattributes IAcadBlockReference2 ) :vlax-true )
              ;Create an array of the attributes
              (setq AttObjLst (vlax-safearray->list (variant-value (vla-getattributes IAcadBlockReference2 ))) )
              ( )
            )
            ;Create a new reference of the same block for the prompt strings
            (setq IAcadBlock3 (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object ))) sBlock ) )
            ;For every attribute in our collection of attributes
            (foreach Attrib AttObjLst
              ;Look for a prompt string
              (vlax-for PromptString IAcadBlock3
                ;If prompt strings are found
                (if (= (vla-get-objectname PromptString ) "AcDbAttributeDefinition" )
                  (progn
                    (if (= (vla-get-promptstring PromptString) sPrompt)
                      (progn
                        (if (= (vla-get-tagstring PromptString) (vla-get-tagstring Attrib))
                          (progn
                            (vla-put-tagstring PromptString sTag)
                            (vla-put-tagstring Attrib sTag)
                            (vla-update IAcadBlock3)
                            (vla-update IAcadBlockReference2)
                          )                    
                          ( )
                        )
                      )
                      ( )
                    )
                  )
                ( )
                )
              )
            )
          )
          (princ "..no object selected." )
        )
        (princ)
      )

      (DEFUN C:TESTER ()
        (BLOCK_TAG_REPLACE "A1-TITLE" "Sheet Title Line 1" "TITLE1" )
      )


***UPDATE***

Well to say the least this works for updating 1 value at a time.  For some reason I cannot figure out while it is canceling after the first run.  It even cancels when being called from inside other functions.  I can't wrap my head around it.

Any ideas anyone?

Regards,
Xander

Title: Re: Update specific block tags
Post by: Lee Mac on August 18, 2009, 08:37:02 AM

This will update the Tag of every block in the drawing with the relevant promptstring :-)

Code: [Select]

(defun c:attupd (/ ss sel doc lst tag)
  (vl-load-com)

  (if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
    (progn
      (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet
                      (setq doc (vla-get-ActiveDocument
                                  (vlax-get-acad-object)))))
        (vlax-for Sub (vla-item
                        (vla-get-Blocks doc)
                          (vla-get-Name Obj))
          (if (eq "AcDbAttributeDefinition"
                (vla-get-ObjectName Sub))
            (setq lst
              (cons
                (cons
                  (vla-get-TagString Sub)
                    (vl-list->string
                      (subst 95 32
                        (vl-string->list
                          (vla-get-PromptString Sub))))) lst))))
        (foreach att (vlax-invoke Obj 'GetAttributes)
          (if (setq tag (assoc (vla-get-TagString att) lst))
            (vla-put-TagString att (cdr tag))))
        (setq lst nil))
      (vla-delete sel))
    (princ "\n** No Attributed Blocks Found **"))
  (princ))