TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: cmwade77 on November 03, 2020, 07:19:34 PM
-
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.
-
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.
-
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:
;;;============================
;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)
)