一起用VLA来制造Table

Free-Lancer · 发表于 2014-3-8 16:29:58

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 Free-Lancer 于 2014-3-8 16:46 编辑

(defun Table:Begin (tb)
(vla-put-TitleSuppressed tb :vlax-true)
(vla-put-HeaderSuppressed tb :vlax-true)
(vla-put-RegenerateTableSuppressed tb :vlax-true)
t
)
(defun Table:End (tb)
(vla-put-titlesuppressed tb :vlax-false)
(vla-put-headersuppressed tb :vlax-false)
(vla-put-RegenerateTableSuppressed tb :vlax-false)
t
)
(defun Table:SetRowHeight (tb lst / i)
(Table:Begin tb)
(if (= (type lst) 'Real)
(progn
(setq i -1)
(repeat (fix (vla-get-rows tb))
(vla-setrowheight tb (setq i (1+ i)) lst)
)
)
(foreach x lst
(vla-setrowheight tb (car x) (cadr x))
)
)
(Table:End tb)
)
(defun Table:SetColumnWidth (tb lst)
(Table:Begin tb)
(if (= (type lst) 'Real)
(progn
(setq i -1)
(repeat (fix (vla-get-columns tb))
(vla-setcolumnwidth tb (setq i (1+ i)) lst)
)
)
(foreach x lst
(vla-setcolumnwidth tb (car x) (cadr x))
)
)
(Table:End tb)
)
;|
AcRowType enum; the row type
acDataRow 0
acHeaderRow 1
acTitleRow 2
acUnknownRow 3
acBottomCenter 8
acBottomLeft 7
acBottomRight 9
acMiddleCenter 5
acMiddleLeft 4
acMiddleRight 6
acTopCenter 2
acTopLeft 1
acTopRight 3
|;
(defun Table:SetAlignment (tb typ mod /)
(vla-setalignment tb typ mod)
)
(defun Table:Make (lst p RowHeight ColWidth / tb i maxCol)
(setq tb (vla-addtable
(fy:acspace)
(vlax-3d-point p)
(1+ (length lst))
(setq maxCol (apply 'max (mapcar 'length lst)))
RowHeight
ColWidth
)
)
(Table:Begin tb)
(setq i 0)
(vla-setalignment tb acDataRow acMiddleCenter) ;_5
(vla-setcellgridvisibility tb 0 0 acTopMask :vlax-false)
(vla-setcellgridvisibility tb 0 0 acLeftMask :vlax-false)
(vla-setcellgridvisibility
tb
0
(1- maxCol)
acRightMask
:vlax-false
)
(mapcar
'(lambda (x / j)
(setq j -1
i (1+ i)
)
(mapcar '(lambda (a)
(vla-settext tb i (setq j (1+ j)) a)
)
x
)
)
lst
)
(Table:End tb)
)

(defun Table:Begin (tb) 
  (vla-put-TitleSuppressed tb :vlax-true) 
  (vla-put-HeaderSuppressed tb :vlax-true) 
  (vla-put-RegenerateTableSuppressed tb :vlax-true) 
  t 
) 
(defun Table:End (tb) 
  (vla-put-titlesuppressed tb :vlax-false) 
  (vla-put-headersuppressed tb :vlax-false) 
  (vla-put-RegenerateTableSuppressed tb :vlax-false) 
  t 
) 
(defun Table:SetRowHeight (tb lst / i) 
  (Table:Begin tb) 
  (if (= (type lst) 'Real) 
    (progn 
      (setq i -1) 
      (repeat (fix (vla-get-rows tb)) 
        (vla-setrowheight tb (setq i (1+ i)) lst) 
      ) 
    ) 
    (foreach x lst 
      (vla-setrowheight tb (car x) (cadr x)) 
    ) 
  ) 
  (Table:End tb) 
) 
(defun Table:SetColumnWidth (tb lst) 
  (Table:Begin tb) 
  (if (= (type lst) 'Real) 
    (progn 
      (setq i -1) 
      (repeat (fix (vla-get-columns tb)) 
        (vla-setcolumnwidth tb (setq i (1+ i)) lst) 
      ) 
    ) 
    (foreach x lst 
      (vla-setcolumnwidth tb (car x) (cadr x)) 
    ) 
  ) 
  (Table:End tb) 
) 
 ;| 
AcRowType enum; the row type 
acDataRow    0 
acHeaderRow  1 
acTitleRow   2 
acUnknownRow 3 
 
acBottomCenter   8 
acBottomLeft     7 
acBottomRight    9 
acMiddleCenter   5 
acMiddleLeft     4 
acMiddleRight    6 
acTopCenter      2 
acTopLeft        1 
acTopRight       3 
|; 
(defun Table:SetAlignment (tb typ mod /) 
  (vla-setalignment tb typ mod) 
) 
(defun Table:Make (lst p RowHeight ColWidth / tb i maxCol) 
  (setq        tb (vla-addtable 
             (fy:acspace) 
             (vlax-3d-point p) 
             (1+ (length lst)) 
             (setq maxCol (apply 'max (mapcar 'length lst))) 
             RowHeight 
             ColWidth 
           ) 
  ) 
  (Table:Begin tb) 
  (setq i 0) 
  (vla-setalignment tb acDataRow acMiddleCenter) ;_5 
  (vla-setcellgridvisibility tb 0 0 acTopMask :vlax-false) 
  (vla-setcellgridvisibility tb 0 0 acLeftMask :vlax-false) 
  (vla-setcellgridvisibility 
    tb 
    0 
    (1- maxCol) 
    acRightMask 
    :vlax-false 
  ) 
  (mapcar 
    '(lambda (x / j) 
       (setq j -1 
             i (1+ i) 
       ) 
       (mapcar '(lambda        (a) 
 
                  (vla-settext tb i (setq j (1+ j)) a) 
                ) 
               x 
       ) 
     ) 
    lst 
  ) 
  (Table:End tb) 
)

(table:Make '(("1" "2" "4") ("2" "4") ("5" "6" "7" "8")) (getpoint) 10. 10.)

(table:setcolumnwidth (e2o (car (entsel))) '((0 15.) (1 20.) (2 25.) (3 10.)))

(table:setcolumnwidth (e2o (car (entsel))) 30.)

dwg001 · 发表于 2014-3-8 22:05:57

长老：可否用动画show 一把？

st788796 · 发表于 2014-3-8 22:43:50

本帖最后由 st788796 于 2014-3-8 22:44 编辑

长老一直是先发测试源码，然后就是整合编译的lib文件

Free-Lancer · 发表于 2014-3-9 00:50:34

dwg001 发表于 2014-3-8 22:05
长老：可否用动画show 一把？

一个简单表格

Free-Lancer · 发表于 2014-3-9 09:34:07

本帖最后由 Free-Lancer 于 2014-3-9 09:35 编辑

大家不常用啊

1 (Table:Begin tb)
功  能: 禁止表格充生成，开始编辑
参  数: 表格Object
返回值: Object

2 (Table:End tb)
功  能: 结束编辑，启用重生成
参  数: 表格Object
返回值: Object

3 (Table:SetRowHeight tb Rowheight)
功  能: 设置Table行高
参  数: tb --- Table Object
      RowHeight --- 实数，统一行高
            ---- 表, ((rownum1 rowheight1) (rownum2 rowheight2) ...)
注  意: 计数由 0 起
返回值: Object

4 (Table:SetColumnWidth tb Colwidth)
功  能: 设置Table列宽
参  数: tb --- Table Object
      RowHeight --- 实数，统一列宽
            ---- 表, ((colnum1 colwidth1) (colnum2 colwidth2) ...)
注  意: 计数由 0 起
返回值: Object

5 (Table:Make lst p RowHeight textheight)
功  能: 制作表格
参  数: lst --- 字串列表
      p --- 插入点，默认当前样式的插入点
      Rowheight --- 行高( INT or Real)
      textheight --- 字高，nil 或 "" 取 0.4 * RowHeight
返回值: Object

dnbcgrass · 发表于 2014-3-10 09:04:36

在acad.dwt模式时，表格的行高小于9时设置无效。

Free-Lancer · 发表于 2014-3-10 09:12:23

dnbcgrass 发表于 2014-3-10 09:04
在acad.dwt模式时，表格的行高小于9时设置无效。

试试这个 fas ，说明见上帖

dnbcgrass · 发表于 2014-3-11 21:53:49

根据st788796 的意见，先将表格缩小到的行高为0.1，再设置行高至要求值即可解决行高设置的问题。

st788796 · 发表于 2014-3-11 22:42:17

xdrx_table_make有同样问题

q3_2006 · 发表于 2015-4-22 14:32:13

向长老请教个问题...块统计时缩略图选择自适应方式...图块高度等于行高...如果想设置成图块高等于行高的85%....有没有什么好效率高点的方法...我用vla-SetBlockScale...来逐个调整...速度好慢呀...听E大说单元格可以设置四个方向的space ....但我没找到相关函数...拜托长老是不是抽空研究下解决办法.....缩略图顶着表格线.....打印出来..确实不太好看呀...{:soso_e110:}

iLisp · 发表于 2015-4-22 16:36:42

本帖最后由 iLisp 于 2015-4-22 16:43 编辑

q3_2006 发表于 2015-4-22 14:32
向长老请教个问题...块统计时缩略图选择自适应方式...图块高度等于行高...如果想设置成图块高等于行高的85% ...

在样式中设置HorzCellMargin VertCellMargin看看效果

q3_2006 · 发表于 2015-4-23 08:36:51

iLisp 发表于 2015-4-22 16:36
在样式中设置HorzCellMargin VertCellMargin看看效果

谢谢回复...我试试...

q3_2006 · 发表于 2015-4-23 10:34:37

iLisp 发表于 2015-4-22 16:36
在样式中设置HorzCellMargin VertCellMargin看看效果

貌似没用...{:soso_e110:}

iLisp · 发表于 2015-4-23 12:18:06

_$ (setq tb (vlax-ename->vla-object (car (entsel))))
#<VLA-OBJECT IAcadTable2 10fe59d4>
_$ (vla-SetBlockTableRecordId tb 1 2 (vla-get-objectid (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)) ) "1"))
:vlax-true)
nil
_$
_$ (vla-put-HorzCellMargin tb 3.0)
nil
_$
_$ (vla-put-HorzCellMargin tb 6)
nil
_$
_$ (vla-put-vertcellmargin tb 3.0)
nil
_$

q3_2006 · 发表于 2015-4-23 13:16:19

iLisp 发表于 2015-4-23 12:18
_$ (setq tb (vlax-ename->vla-object (car (entsel))))
#
_$ (vla-SetBlockTableRecordId tb 1 2 (vla ...

谢谢......我太笨了...先STYLE里面设置好...再填的表...理解差很大....{:soso_e110:}

账号		自动登录	找回密码
密码			立即注册

[原创] 一起用VLA来制造Table

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评