【K:CreateTabSty】创建表格样式并置为当前

kucha007

根据这篇贴子的资料就行了调整：https://hyperpics.blogs.com/beyond_the_ui/2012/07/creating-a-table-style-with-autolisp-and-the-activex-api.html

1. (defun K:CreateTabSty (StyNam MaxTxt MinTxt Margin / dictObj TabSty)
   
2.     ;; 获取 Dictionary 集合和 TableStyle 字典
   
3.     (setq dictObj (vla-Item (vla-get-Dictionaries (vla-get-activedocument (vlax-get-acad-object))) "acad_tablestyle"))
   
4.     (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list dictObj StyNam)))
   
5.         (progn
   
6.               ;创建自定义表格
   
7.               ;(setq StyNam "WorkTools")
   
8.               (setq TabSty (vla-AddObject dictObj StyNam "AcDbTableStyle"))
   
9. 
   
10.               ;样式名称和注释
    
11.               (vla-put-Name TabSty StyNam)
    
12.               (vla-put-Description TabSty "用于统计数据")
    
13. 
    
14.               ;设置样式的位标志值
    
15.               (vla-put-BitFlags TabSty 1)
    
16. 
    
17.               ;设置表格的方向，从上到下或从下到上
    
18.               (vla-put-FlowDirection TabSty acTableTopToBottom)
    
19. 
    
20.               ;; Sets the supression of the table header
    
21.               (vla-put-HeaderSuppressed TabSty :vlax-false)
    
22.               ;; Sets the supression of the table title
    
23.               (vla-put-TitleSuppressed TabSty :vlax-false)
    
24.             
    
25.               ;水平边距+垂直边距
    
26.               (vla-put-HorzCellMargin TabSty Margin)
    
27.               (vla-put-VertCellMargin TabSty Margin)
    
28. 
    
29.               ;文字居中对齐
    
30.               (vla-SetAlignment TabSty (+ acDataRow acTitleRow) acMiddleCenter)
    
31.               (vla-SetAlignment TabSty acHeaderRow acMiddleCenter)
    
32. 
    
33.               ;|设置标题行和表头行的背景颜色
    
34.                 (setq colObj (vlax-create-object (strcat "AutoCAD.AcCmColor." (substr (getvar "ACADVER") 1 2))))
    
35.                 (vla-SetRGB colObj 98 136 213)
    
36.                 (vla-SetBackgroundColor TabSty (+ acHeaderRow acTitleRow) colObj)
    
37.                 ;; Release the color object
    
38.                 (vlax-release-object colObj)
    
39.               |;
    
40. 
    
41.               ;清除数据行的背景颜色
    
42.               (vla-SetBackgroundColorNone TabSty acDataRow :vlax-true)
    
43.               ;|
    
44.                 ;设置标题行底部网格颜色
    
45.                 (vla-SetRGB colObj 0 0 255)
    
46.                 (vla-SetGridColor TabSty acHorzBottom acTitleRow colObj)
    
47.                
    
48.                 ;设置标题行的底部网格线线宽
    
49.                 (vla-SetGridLineWeight TabSty acHorzBottom acTitleRow acLnWt025)
    
50.               |;
    
51.               ;为数据行和标题行设置可见的网格水平线
    
52.               (vla-SetGridVisibility TabSty acHorzInside  (+ acHeaderRow acDataRow) :vlax-true)
    
53.               ;设置文本样式
    
54.               (vla-SetTextStyle TabSty (+ acDataRow acHeaderRow acTitleRow) "Standard")
    
55.               ;设置标题、表头和数据行的文本高度
    
56.               (vla-SetTextHeight TabSty acTitleRow MaxTxt)
    
57.               (vla-SetTextHeight TabSty (+ acDataRow acHeaderRow) MinTxt)
    
58.               (setvar 'ctablestyle StyNam)
    
59.         )
    
60.         (setvar 'ctablestyle StyNam)
    
61.     )
    
62.     (princ)
    
63. )
    

(defun K:CreateTabSty (StyNam MaxTxt MinTxt Margin / dictObj TabSty)<br />     ;; 获取 Dictionary 集合和 TableStyle 字典<br />     (setq dictObj (vla-Item (vla-get-Dictionaries (vla-get-activedocument (vlax-get-acad-object))) "acad_tablestyle"))<br />     (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list dictObj StyNam)))<br />         (progn<br />               ;创建自定义表格<br />               ;(setq StyNam "WorkTools")<br />               (setq TabSty (vla-AddObject dictObj StyNam "AcDbTableStyle"))<br /> <br />               ;样式名称和注释<br />               (vla-put-Name TabSty StyNam)<br />               (vla-put-Description TabSty "用于统计数据")<br /> <br />               ;设置样式的位标志值<br />               (vla-put-BitFlags TabSty 1)<br /> <br />               ;设置表格的方向，从上到下或从下到上<br />               (vla-put-FlowDirection TabSty acTableTopToBottom)<br /> <br />               ;; Sets the supression of the table header<br />               (vla-put-HeaderSuppressed TabSty :vlax-false)<br />               ;; Sets the supression of the table title<br />               (vla-put-TitleSuppressed TabSty :vlax-false)<br />             <br />               ;水平边距+垂直边距<br />               (vla-put-HorzCellMargin TabSty Margin)<br />               (vla-put-VertCellMargin TabSty Margin)<br /> <br />               ;文字居中对齐<br />               (vla-SetAlignment TabSty (+ acDataRow acTitleRow) acMiddleCenter)<br />               (vla-SetAlignment TabSty acHeaderRow acMiddleCenter)<br /> <br />               ;|设置标题行和表头行的背景颜色<br />                 (setq colObj (vlax-create-object (strcat "<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>.AcCmColor." (substr (getvar "ACADVER") 1 2))))<br />                 (vla-SetRGB colObj 98 136 213)<br />                 (vla-SetBackgroundColor TabSty (+ acHeaderRow acTitleRow) colObj)<br />                 ;; Release the color object<br />                 (vlax-release-object colObj)<br />               |;<br /> <br />               ;清除数据行的背景颜色<br />               (vla-SetBackgroundColorNone TabSty acDataRow :vlax-true)<br />               ;|<br />                 ;设置标题行底部网格颜色<br />                 (vla-SetRGB colObj 0 0 255)<br />                 (vla-SetGridColor TabSty acHorzBottom acTitleRow colObj)<br />                 <br />                 ;设置标题行的底部网格线线宽<br />                 (vla-SetGridLineWeight TabSty acHorzBottom acTitleRow acLnWt025)<br />               |;<br />               ;为数据行和标题行设置可见的网格水平线<br />               (vla-SetGridVisibility TabSty acHorzInside  (+ acHeaderRow acDataRow) :vlax-true)<br />               ;设置文本样式<br />               (vla-SetTextStyle TabSty (+ acDataRow acHeaderRow acTitleRow) "Standard")<br />               ;设置标题、表头和数据行的文本高度<br />               (vla-SetTextHeight TabSty acTitleRow MaxTxt)<br />               (vla-SetTextHeight TabSty (+ acDataRow acHeaderRow) MinTxt)<br />               (setvar 'ctablestyle StyNam)<br />         )<br />         (setvar 'ctablestyle StyNam)<br />     )<br />     (princ)<br /> )<br />

用法：

1. (K:CreateTabSty "WorkTools" 5.0 4.0 0.0)
   

(K:CreateTabSty "WorkTools" 5.0 4.0 0.0)<br />

panliang9

谢谢楼主分享！

技术工作室

谢谢楼主分享！