Update Lisp (command machtprop) for tables

[leo321]

(defun c:M2atchTableOverrides (/ Sel FromObj ToObj cnt TitleList HeaderList
DataList tempCnt RowCnt GetValue)

(if
(and
(setq Sel (entsel "\n Select table to copy properties from: "))
(setq FromObj (vlax-ename->vla-object (car Sel)))
(= (vla-get-ObjectName FromObj) "AcDbTable")
(setq Sel (entsel "\n Select table to copy properties to: "))
(setq ToObj (vlax-ename->vla-object (car Sel)))
(= (vla-get-ObjectName ToObj) "AcDbTable")
)
(progn
(vla-put-RegenerateTableSuppressed ToObj :vlax-true)
(foreach RowType (list (cons acDataRow "Data Row") (cons acHeaderRow
"Header Row") (cons acTitleRow "Title Row") (cons acUnknownRow "Unknow
Row"))
(mapcar
'(lambda (SetStr GetStr)
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vlax-invoke
(list
ToObj SetStr (car RowType)
(setq GetValue (vlax-invoke FromObj GetStr (car RowType)))
)
)
)
(prompt
(strcat
"\n Couldn't set property \""
(substr SetStr 4)
"\" for row type \""
(cdr RowType)
"\" to [ "
(vl-princ-to-string GetValue)
" ]"
)
)
)
)
'("SetContentColor" "SetTextHeight" "SetTextStyle" "SetRowHeight"
"SetColumnWidth")
'("GetContentColor" "GetTextHeight" "GetTextStyle" "GetRowHeight"
"GetColumnWidth")
)
)
(setq cnt 0)
(if (= (vla-get-TitleSuppressed FromObj) :vlax-false)
(progn
(setq TitleList
(list
(vlax-invoke FromObj 'GetCellTextStyle cnt 0)
(vlax-invoke FromObj 'GetCellTextHeight cnt 0)
(vlax-invoke FromObj 'GetCellContentColor cnt 0)
(vlax-invoke FromObj 'GetRowHeight cnt)
)
)
(setq cnt (1+ cnt))
)
)
(if (= (vla-get-HeaderSuppressed FromObj) :vlax-false)
(progn
(setq HeaderList
(list
(vlax-invoke FromObj 'GetCellTextStyle cnt 0)
(vlax-invoke FromObj 'GetCellTextHeight cnt 0)
(vlax-invoke FromObj 'GetCellContentColor cnt 0)
(vlax-invoke FromObj 'GetRowHeight cnt)
)
)
(setq cnt (1+ cnt))
)
)
(setq DataList
(list
(vlax-invoke FromObj 'GetCellTextStyle cnt 0)
(vlax-invoke FromObj 'GetCellTextHeight cnt 0)
(vlax-invoke FromObj 'GetCellContentColor cnt 0)
(vlax-invoke FromObj 'GetRowHeight cnt)
)
)
(setq cnt 0)
(if
(and
(= (vla-get-TitleSuppressed ToObj) :vlax-false)
TitleList
)
(progn
(setq tempCnt 0)
(vlax-invoke ToObj 'SetRowHeight cnt (cadddr TitleList))
(repeat (vla-get-Columns ToObj)
(mapcar
'(lambda (a b)
(vlax-invoke ToObj a cnt tempCnt b)
)
'("SetCellTextStyle" "SetCellTextHeight" "SetCellContentColor")
TitleList
)
(setq tempCnt (1+ tempCnt))
)
(setq cnt (1+ cnt))
)
)
(if
(and
(= (vla-get-HeaderSuppressed ToObj) :vlax-false)
HeaderList
)
(progn
(vlax-invoke ToObj 'SetRowHeight cnt (cadddr HeaderList))
(setq tempCnt 0)
(repeat (vla-get-Columns ToObj)
(mapcar
'(lambda (a b)
(vlax-invoke ToObj a cnt tempCnt b)
)
'("SetCellTextStyle" "SetCellTextHeight" "SetCellContentColor")
HeaderList
)
(setq tempCnt (1+ tempCnt))
)
(setq cnt (1+ cnt))
)
)
(setq RowCnt cnt)
(repeat (- (vla-get-Rows ToObj) cnt)
(vlax-invoke ToObj 'SetRowHeight RowCnt (cadddr DataList))
(setq tempCnt 0)
(repeat (vla-get-Columns ToObj)
(mapcar
'(lambda (a b)
(vlax-invoke ToObj a RowCnt tempCnt b)
)
'("SetCellTextStyle" "SetCellTextHeight" "SetCellContentColor")
DataList
)
(setq tempCnt (1+ tempCnt))
)
(setq RowCnt (1+ RowCnt))
)
(vla-put-RegenerateTableSuppressed ToObj :vlax-false)
)
)
(princ)
)

 

 

This one, you click the original table (with right height cell and text,)

than second click on table you desire to migrate same propriteis.

My Goal is change second click to select multi table (more than one, like select all by hold right mouse bottom) .

 

thx

 

 

[mhupp]

Untested but should work if everything else in the lisp works. added an error message at the end if you didn't select two tables it just exit lisp. now it will display "Not a Table Pick again"

 

;Change
(and
  (setq Sel (entsel "\n Select table to copy properties from: "))
  (setq FromObj (vlax-ename->vla-object (car Sel)))
  (= (vla-get-ObjectName FromObj) "AcDbTable")
  (setq Sel (entsel "\n Select table to copy properties to: "))
  (setq ToObj (vlax-ename->vla-object (car Sel)))
  (= (vla-get-ObjectName ToObj) "AcDbTable")
)
(progn
;//////////////////////////////////////////////////////////////////
;To
(and
  (setq Sel (entsel "\n Select table to copy properties from: "))
  (setq FromObj (vlax-ename->vla-object (car Sel)))
  (= (vla-get-ObjectName FromObj) "AcDbTable")
  (setq ss (ssget '((0 . "ACAD_TABLE"))))
 )
 (foreach Tobj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))))
....
;at the end
    (prompt "\nNot a Table Pick again") ;if either the first or 2nd table isn't picked display error msg
  )
  (princ)
)

 

 

[BIGAL]

What would be helpful is to get all the settings so could make a table style, save them into say a csv file, then a make Tablestyle could be ran, getting a table to match a client setting involves many properties. list of methods for a table.txt

Edited March 5 by BIGAL

[leo321]

Hi, Bigal i try some changes, like do some loop to continue paste same properties, but still no progress, if you can help, i´ll be grateful.

[BIGAL]

You need to run dumpit.lsp and look at the properties dump and all the set values you can change so work out what properties your trying to change like column widths, row heights, text heights & margins, text alignment. There are just so many you can change.

 

Some 204 properties are listed as can be changed.

 

Write a list of what your trying to match and post.

[leo321]

it just this ones; run the dumpit, come lot settings  , bring them above. 

 

 

default wanted;  

Row style (title)
SetCellWidth    210
SetCellHeight    13
SetCellTextHeight    3
SetTextStyle    Standard
Alignment    middle center

---------------------
Row style (Data)

SetCellHeight    7.30
SetCellWidth    35
SetCellTextHeight    3
SetTextStyle    Standard
Alignment    middle center

--------------------------------------------------------

 

I got it 800 table  are same number of columm, just change number of rows of each table.

this take of one already ok.

Select object: ; IAcadTable: IAcadTable Interface
; Property values:
;   AllowManualHeights = 0
;   AllowManualPositions = 0
;   Application (RO) = #<VLA-OBJECT IAcadApplication 00007ff7a3e91e30>
;   BreaksEnabled = 0
;   BreakSpacing = 6.93
;   Columns = 6
;   ColumnWidth (RO) = ...Indexed contents not shown...
;   Direction = (1.0 0.0 0.0)
;   Document (RO) = #<VLA-OBJECT IAcadDocument 000002473878c528>
;   EnableBreak (RO) = ...Indexed contents not shown...
;   EntityTransparency = "ByLayer"
;   FlowDirection = 0
;   Handle (RO) = "1E190C"
;   HasExtensionDictionary (RO) = 0
;   HasSubSelection (RO) = 0
;   HeaderSuppressed = 0
;   Height = 136.391
;   HorzCellMargin = 0.42
;   Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 000002474cfe6b08>
;   InsertionPoint = (697.392 1194.42 0.0)
;   Layer = "TEXTO AREAS"
;   Linetype = "ByLayer"
;   LinetypeScale = 1.0
;   Lineweight = -1
;   Material = "ByLayer"
;   MinimumTableHeight (RO) = 89.6904
;   MinimumTableWidth (RO) = 23.04
;   ObjectID (RO) = 880
;   ObjectName (RO) = "AcDbTable"
;   OwnerID (RO) = 217
;   PlotStyleName = "ByLayer"
;   RegenerateTableSuppressed = 0
;   RepeatBottomLabels = 0
;   RepeatTopLabels = 0
;   RowHeight (RO) = ...Indexed contents not shown...
;   Rows = 18
;   StyleName = "Standard"
;   TableBreakFlowDirection = 1
;   TableBreakHeight = 0.0
;   TableStyleOverrides (RO) = (4 5 21 22 23)
;   TitleSuppressed = 0
;   TrueColor = #<VLA-OBJECT IAcadAcCmColor 000002474cfe71c0>
;   VertCellMargin = 0.42
;   Visible = -1
;   Width = 210.0
; Methods supported:
;   ArrayPolar (3)
;   ArrayRectangular (6)
;   ClearSubSelection ()
;   ClearTableStyleOverrides (1)
;   Copy ()
;   CreateContent (3)
;   Delete ()
;   DeleteCellContent (2)
;   DeleteColumns (2)
;   DeleteContent (2)
;   DeleteRows (2)
;   EnableMergeAll (3)
;   FormatValue (4)
;   GenerateLayout ()
;   GetAlignment (1)
;   GetAttachmentPoint (2)
;   GetAutoScale (2)
;   GetAutoScale2 (3)
;   GetBackgroundColor (1)
;   GetBackgroundColorNone (1)
;   GetBlockAttributeValue (3)
;   GetBlockAttributeValue2 (4)
;   GetBlockRotation (2)
;   GetBlockScale (2)
;   GetBlockTableRecordId (2)
;   GetBlockTableRecordId2 (3)
;   GetBoundingBox (2)
;   GetBreakHeight (1)
;   GetCellAlignment (2)
;   GetCellBackgroundColor (2)
;   GetCellBackgroundColorNone (2)
;   GetCellContentColor (2)
;   GetCellDataType (4)
;   GetCellExtents (3)
;   GetCellFormat (2)
;   GetCellGridColor (3)
;   GetCellGridLineWeight (3)
;   GetCellGridVisibility (3)
;   GetCellState (2)
;   GetCellStyle (2)
;   GetCellStyleOverrides (2)
;   GetCellTextHeight (2)
;   GetCellTextStyle (2)
;   GetCellType (2)
;   GetCellValue (2)
;   GetColumnName (1)
;   GetColumnWidth (1)
;   GetContentColor (1)
;   GetContentColor2 (3)
;   GetContentLayout (2)
;   GetContentType (2)
;   GetCustomData (4)
;   GetDataFormat (3)
;   GetDataType (3)
;   GetDataType2 (5)
;   GetExtensionDictionary ()
;   GetFieldId (2)
;   GetFieldId2 (3)
;   GetFormat (1)
;   GetFormula (3)
;   GetGridColor (2)
;   GetGridColor2 (3)
;   GetGridDoubleLineSpacing (3)
;   GetGridLineStyle (3)
;   GetGridLinetype (3)
;   GetGridLineWeight (2)
;   GetGridLineWeight2 (3)
;   GetGridVisibility (2)
;   GetGridVisibility2 (3)
;   GetHasFormula (3)
;   GetMargin (3)
;   GetMinimumColumnWidth (1)
;   GetMinimumRowHeight (1)
;   GetOverride (3)
;   GetRotation (3)
;   GetRowHeight (1)
;   GetRowType (1)
;   GetScale (3)
;   GetSubSelection (4)
;   GetText (2)
;   GetTextHeight (1)
;   GetTextHeight2 (3)
;   GetTextRotation (2)
;   GetTextString (3)
;   GetTextStyle (1)
;   GetTextStyle2 (3)
;   GetValue (3)
;   GetXData (3)
;   Highlight (1)
;   HitTest (4)
;   InsertColumns (3)
;   InsertColumnsAndInherit (3)
;   InsertRows (3)
;   InsertRowsAndInherit (3)
;   IntersectWith (2)
;   IsContentEditable (2)
;   IsEmpty (2)
;   IsFormatEditable (2)
;   IsMergeAllEnabled (2)
;   IsMergedCell (6)
;   MergeCells (4)
;   Mirror (2)
;   Mirror3D (3)
;   Move (2)
;   MoveContent (4)
;   RecomputeTableBlock (1)
;   RemoveAllOverrides (2)
;   ReselectSubRegion ()
;   ResetCellValue (2)
;   Rotate (2)
;   Rotate3D (3)
;   ScaleEntity (2)
;   Select (8)
;   SelectSubRegion (10)
;   SetAlignment (2)
;   SetAutoScale (3)
;   SetAutoScale2 (4)
;   SetBackgroundColor (2)
;   SetBackgroundColorNone (2)
;   SetBlockAttributeValue (4)
;   SetBlockAttributeValue2 (5)
;   SetBlockRotation (3)
;   SetBlockScale (3)
;   SetBlockTableRecordId (4)
;   SetBlockTableRecordId2 (5)
;   SetBreakHeight (2)
;   SetCellAlignment (3)
;   SetCellBackgroundColor (3)
;   SetCellBackgroundColorNone (3)
;   SetCellContentColor (3)
;   SetCellDataType (4)
;   SetCellFormat (3)
;   SetCellGridColor (4)
;   SetCellGridLineWeight (4)
;   SetCellGridVisibility (4)
;   SetCellState (3)
;   SetCellStyle (3)
;   SetCellTextHeight (3)
;   SetCellTextStyle (3)
;   SetCellType (3)
;   SetCellValue (3)
;   SetCellValueFromText (4)
;   SetColumnName (2)
;   SetColumnWidth (2)
;   SetContentColor (2)
;   SetContentColor2 (4)
;   SetContentLayout (3)
;   SetCustomData (4)
;   SetDataFormat (4)
;   SetDataType (3)
;   SetDataType2 (5)
;   SetFieldId (3)
;   SetFieldId2 (5)
;   SetFormat (2)
;   SetFormula (4)
;   SetGridColor (3)
;   SetGridColor2 (4)
;   SetGridDoubleLineSpacing (4)
;   SetGridLineStyle (4)
;   SetGridLinetype (4)
;   SetGridLineWeight (3)
;   SetGridLineWeight2 (4)
;   SetGridVisibility (3)
;   SetGridVisibility2 (4)
;   SetMargin (4)
;   SetOverride (4)
;   SetRotation (4)
;   SetRowHeight (2)
;   SetScale (4)
;   SetSubSelection (4)
;   SetText (3)
;   SetTextHeight (2)
;   SetTextHeight2 (4)
;   SetTextRotation (3)
;   SetTextString (4)
;   SetTextStyle (2)
;   SetTextStyle2 (4)
;   SetToolTip (3)
;   SetValue (4)
;   SetValueFromText (5)
;   SetXData (2)
;   TransformBy (1)
;   UnmergeCells (4)
;   Update ()

 

[BIGAL]

 

 

2 ways to do tables make a table style that suits, or I found some times simpler make a table but before adding lots of cell values edit the table properties then add cells. I normally only do 3 rows when I make a table a Title, header and data row. Then reset all the values, I use VL  INSERTROW which adds rows as required. 

 

(defun AH:maketable ( / pt1 numrows numcolumns rowheight colwidth ) 
(setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table:  "))) 
(setq numrows 3)
(setq numcolumns 6)
(setq rowheight 0.3)
(setq colwidth 1.8)
(setq curspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
(vla-SetTextStyle Objtable (+ acDataRow acHeaderRow acTitleRow) "Arial")
(vla-Setcolumnwidth Objtable  0 35)
(vla-Setcolumnwidth Objtable  1 35)
(vla-Setcolumnwidth Objtable  2 35)
(vla-Setcolumnwidth Objtable  3 35)
(vla-Setcolumnwidth Objtable  4 35)
(vla-Setcolumnwidth Objtable  4 35)
(vla-SetTextHeight Objtable acDataRow 3)
(vla-SetTextHeight Objtable acHeaderRow 3)
(vla-SetTextHeight Objtable acTitleRow 7)
(vla-settext objtable 0 0 "Heading 1")
(vla-settext objtable 1 0 "Title 1") 
(vla-settext objtable 1 1 "Title 2")
(setq objtable (vlax-ename->vla-object (entlast)))
)

(setq rowcnt 2) ; 1st row as data
(setq rowhgt (vla-getRowHeight objtable 2)) ; data row
; in a loop
(vla-InsertRows objTable rowcnt rowhgt 1)
; put cell values here
(setq rowcnt (1+ rowcnt))
; end loop

 

Edited April 1 by BIGAL