TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: V-Man on January 06, 2011, 11:34:43 AM

Title: Block attribute to text
Post by: V-Man on January 06, 2011, 11:34:43 AM

Ok, i will just throw this out there. I need to be able to scan an entire drawing for a particular block (BLOCK1) and read a particular attribute (CITY) inside each block and insert a peice of regular single line text exactly at the same insertion point of the attribute (CITY) and make the text say what's in the attribute. Now mind you there are literally a couple thousand blocks to do this for in each drawing and the value for (CITY) is different in each.

I hope i explained this correctly.
Title: Re: Block attribute to text
Post by: T.Willey on January 06, 2011, 11:38:53 AM
Will the text be placed inside the block definition ( not really gonna work if so ), or will it be placed within the ' space ' the block is inserted?

How much have you gotten written?
Title: Re: Block attribute to text
Post by: Guitar_Jones on January 06, 2011, 11:42:38 AM
Modified one of Jimmy Bergmark's examples.
Code: [Select]
;;; (B2T "BLOCKNAME" "TAGNAME")
;;;  Creates Text from block attribute according to block/tag name
(defun B2T (bn tagname / Doc layout i atts tag str attript txtobj)
(setq Doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark Doc)
(vla-StartUndoMark Doc)
  (vlax-for layout (vla-get-layouts Doc)
    (vlax-for i (vla-get-block layout)
      (if (and
            (= (vla-get-objectname i) "AcDbBlockReference")
            (/= (vl-string-search (strcase bn) (strcase (vla-get-name i))) nil)
          )
        (if (and
              (= (vla-get-hasattributes i) :vlax-true)
              (safearray-value
                (setq atts
                       (vlax-variant-value
                         (vla-getattributes i)
                       )
                )
              )
            )
          (foreach tag (vlax-safearray->list atts)
            (if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
     (progn
     (setq attript (cdr (assoc 10 (entget (vlax-vla-object->ename tag)))))
              (setq str (vla-get-TextString tag))
     (setq txtobj
   (vla-addText
              (vla-get-modelspace Doc)
     str
     (vlax-3d-point attript)
                        (getvar 'textsize)
   );vla
     )
(vla-put-alignment txtObj acAlignmentMiddleCenter)
(vla-put-textalignmentpoint txtobj (vlax-3d-point attript))
     );progn
            )
          )
        )
      )
    )
  )
(vla-EndUndoMark Doc)
)

Could at least be used as a starting point...
Title: Re: Block attribute to text
Post by: V-Man on January 06, 2011, 11:47:40 AM

Quote
Will the text be placed inside the block definition ( not really gonna work if so ), or will it be placed within the ' space ' the block is inserted?


No, the text will be written as just plain text outside the block definition, ontop if you will.
Title: Re: Block attribute to text
Post by: T.Willey on January 06, 2011, 11:50:03 AM
Not a good code to use.  No matter what layout you find the block in, you are only adding text to model space.

Code: [Select]
  (vlax-for layout (vla-get-layouts Doc)
    (vlax-for i (vla-get-block layout)

<snip>
      (setq txtobj
  (vla-addText
              (vla-get-modelspace Doc)
    str
    (vlax-3d-point attript)
                        (getvar 'textsize)
  );vla
      )
Title: Re: Block attribute to text
Post by: V-Man on January 06, 2011, 11:57:47 AM

Quote
Modified one of Jimmy Bergmark's examples.

Code: [Select]
;;; (B2T "BLOCKNAME" "TAGNAME")
;;;  Creates Text from block attribute according to block/tag name
(defun B2T (bn tagname / Doc layout i atts tag str attript txtobj)
(setq Doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark Doc)
(vla-StartUndoMark Doc)
  (vlax-for layout (vla-get-layouts Doc)
    (vlax-for i (vla-get-block layout)
      (if (and
            (= (vla-get-objectname i) "AcDbBlockReference")
            (/= (vl-string-search (strcase bn) (strcase (vla-get-name i))) nil)
          )
        (if (and
              (= (vla-get-hasattributes i) :vlax-true)
              (safearray-value
                (setq atts
                       (vlax-variant-value
                         (vla-getattributes i)
                       )
                )
              )
            )
          (foreach tag (vlax-safearray->list atts)
            (if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
     (progn
     (setq attript (cdr (assoc 10 (entget (vlax-vla-object->ename tag)))))
              (setq str (vla-get-TextString tag))
     (setq txtobj
  (vla-addText
             (vla-get-modelspace Doc)
    str
    (vlax-3d-point attript)
                        (getvar 'textsize)
  );vla
     )
(vla-put-alignment txtObj acAlignmentMiddleCenter)
(vla-put-textalignmentpoint txtobj (vlax-3d-point attript))
     );progn
            )
          )
        )
      )
    )
  )
(vla-EndUndoMark Doc)
)



This actually works great. I thought something like this already existed and I did not want to reinvent the wheel.

Thanks
Title: Re: Block attribute to text
Post by: mjfarrell on January 06, 2011, 12:03:36 PM

Ok, i will just throw this out there. I need to be able to scan an entire drawing for a particular block (BLOCK1) and read a particular attribute (CITY) inside each block and insert a peice of regular single line text exactly at the same insertion point of the attribute (CITY) and make the text say what's in the attribute. Now mind you there are literally a couple thousand blocks to do this for in each drawing and the value for (CITY) is different in each.

I hope i explained this correctly.
Do you have access to MAP.
If yes, MAP will do this for you through a query operation.
If no, never mind.
Title: Re: Block attribute to text
Post by: Lee Mac on January 06, 2011, 02:48:58 PM
How about something along these lines:

Code: [Select]
(defun AddTextToAttribute ( block tag / ss doc ) (vl-load-com)
  ;; Example by Lee Mac 2011  -  www.lee-mac.com
  (setq tag (strcase tag))

  (if (ssget "_X" (list (cons 0 "INSERT") (cons 2 block) (cons 66 1)))
    (progn
      (vlax-for obj
        (setq ss
          (vla-get-ActiveSelectionSet
            (setq doc
              (vla-get-ActiveDocument (vlax-get-acad-object))
            )
          )
        )
        (
          (lambda ( space )
            (mapcar
              (function
                (lambda ( attrib )
                  (if (eq tag (strcase (vla-get-TagString attrib)))
                    (vla-AddText space
                      (vla-get-TextString attrib) (vla-get-InsertionPoint attrib) (vla-get-Height Attrib)
                    )
                  )
                )
              )
              (vlax-invoke obj 'GetAttributes)
            )
          )
          (vla-ObjectIDtoObject doc (vla-get-OwnerID obj))
        )
      )
      (vla-delete ss)
    )
  )
  (princ)
)

Current Restrictions: Doesn't match attribute alignment & other props