Topic: Moving Blocks to Table Cells

[cmwade77]

I sometimes have tables with blocks that were simply placed on top of tables, I would like to change them to where they are inserted into the cells as blocks, see attached video. Does anyone have a LISP routine to do this already? I can think of a few ways to accomplish this, but I am trying to avoid reinventing the wheel if it is already out there.

[Grrr1337]

Perhaps look into the vla-SetCellAlignment method.
BTW providing a sample drawing with before and after would be the best way to ease-up the answering for such question.

[cmwade77]

Not quite what I needed, it isn't about aligning, but rather having blocks that are on top of a table that need to be inserted into the table and then erased.

I managed to come up with some code to accomplish this:

Code: [Select]

;;;============================
  ;Add block to table - from https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/block-in-table/m-p/7827041/highlight/true#M366009
  (defun InsertBlockTable (tableobject row column blockname / bk fg id bkid)
    (setq bk (vla-item (vla-get-blocks
            (vla-get-activedocument (vlax-get-acad-object))
          )
          blockname
      )
    )
    (if (vlax-method-applicable-p
    tableobject
    'setblocktablerecordid32
        )
      (setq id (vla-get-objectid32 bk)
      fg t
      )
      (setq id (vla-get-objectid bk))
    )
    ((if fg
      vla-setblocktablerecordid32
      vla-setblocktablerecordid
    )
      tableobject row column id :vlax-false)
  )
 
;;;============================
  ;Change Attribute Value
  (defun ChangeAttr (TableObject Row Column BlockName Value / BlockCollection Bk AttID EachBk)
    (setq BlockCollection (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
          Bk (vla-item BlockCollection BlockName)
    )
    (vlax-for EachBk Bk
      (if (= (vla-get-objectname EachBk) "AcDbAttributeDefinition")
        (Setq AttID (vla-get-objectid EachBk))
      )
    )
    (vla-setblockattributevalue TableObject Row Column AttID Value)
  )
(defun c:MergeBlocks (/ outRow outCol SubsetFilter pt tableObj SS Total Count Obj ObjName Ent BlockName InsPoint FirstValue)
  ;Supporting Functions
  ;; Effective Block Name  -  Lee Mac
  ;; obj - [vla] VLA Block Reference object

  (defun LM:effectivename ( obj )
      (vlax-get-property obj
          (if (vlax-property-available-p obj 'effectivename)
              'effectivename
              'name
          )
      )
  )
 
  ;; Get Attribute Values  -  Lee Mac
  ;; Returns an association list of attributes present in the supplied block.
  ;; blk - [vla] VLA Block Reference Object
  ;; Returns: [lst] Association list of ((<tag> . <value>) ... )

  (defun LM:vl-getattributevalues ( blk )
      (mapcar '(lambda ( att ) (vla-get-textstring att)) (vlax-invoke blk 'getattributes))
  )
  ;End of Supporting Functions
  (setq SubsetFilter "**Current**")
  (princ "\nSelect tables and blocks:")
  (setq SS (ssget '((-4 . "<OR") (0 . "ACAD_TABLE") (0 . "INSERT") (-4 . "OR>")))
        Total (sslength SS)
        Count 0
  )
  (while (and (not tableObj) (< Count Total))
    (setq Ent (ssname SS Count)
          Obj (vlax-ename->vla-object Ent)
          ObjName (vla-get-objectname Obj)
    )
    (if (= ObjName "AcDbTable")
      (progn
        (ssdel Ent SS)
        (setq tableObj Obj
              Total (sslength SS)
              Count 0
        )
      )
      (setq Count (+ Count 1))
    )
  )
  (if tableObj
    (progn
      (vla-put-regeneratetablesuppressed tableObj :vlax-true)
      (while (< Count Total)
        (setq Ent (ssname SS Count)
              Obj (vlax-ename->vla-object Ent)
              ObjName (vla-get-objectname Obj)
        )
        (if (= ObjName "AcDbBlockReference")
          (progn
            (setq BlockName (LM:effectivename Obj)
                  InsPoint (vla-get-insertionpoint Obj)
            )         
            (vla-HitTest tableObj InsPoint (vlax-3d-point (trans (getvar 'ViewDir) 1 0)) 'outRow 'outCol)
            (if (and outRow outCol)
              (progn
                (InsertBlockTable tableObj outRow outCol BlockName)
                (vla-setcellalignment tableObj outRow outCol acMiddleCenter)
                (setq AttValues (LM:vl-getattributevalues Obj))
                (if AttValues
                  (progn
                    (setq FirstValue (nth 0 AttValues))
                    (ChangeAttr tableObj outRow outCol BlockName FirstValue)
                  )
                )
                (if (not (vlax-erased-p Obj))
                  (vla-delete Obj)
                )
              )
            )
            (setq outRow nil
                  outCol nil
            )
          )
        )
        (setq Count (+ Count 1))
      )
      (vla-put-regeneratetablesuppressed tableObj :vlax-false)
    )
  )
  (princ)
)