简单绘制表格

77077 · 发表于 2016-6-1 23:18:12

本帖最后由 77077 于 2016-6-1 23:44 编辑

;;; 简单绘制表格
(defun AddTable (Title datalst RowH / TableList-C2R datalst colms maxrow
wlst tabela row colm i
)
(defun TableList-C2R (lst n / l lst)
(setq l nil)
(repeat n
(setq l (cons (mapcar
'car
lst
) l
)
lst (mapcar
'cdr
lst
)
)
)
(reverse l)
)
(setq datalst (mapcar
'(lambda (y)
(mapcar
'vl-princ-to-string
y
)
)
datalst
)
colms (length datalst)
maxrow (apply
'max
(mapcar
'length
datalst
)
)
wlst (mapcar
'(lambda (x)
(apply
'max
(mapcar
'(lambda (y)
(if y
(strlen y)
0
)
)
x
)
)
)
(TableList-C2R datalst maxrow)
)
tabela (vla-addTable (vla-get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
) (vlax-3d-point (getpoint "\nPick a point to create the table."))
(1+ colms) maxrow RowH (* RowH 50)
)
)
(vla-put-regenerateTableSuppressed tabela :vlax-true)
(setq i -1)
(foreach w wlst
(vla-setcolumnwidth tabela (setq i (1+ i))
(* w RowH)
)
)
; (vla-SetTextStyle tabela (+ acDataRow acHeaderRow acTitleRow) "样式 1")
(vla-SetTextHeight tabela acTitleRow (* 0.75 RowH))
(vla-SetTextHeight tabela (+ acDataRow acHeaderRow) (* 0.5 RowH))
(vla-setalignment tabela acDataRow acMiddleCenter)
(vla-setText tabela 0 0 Title)
(setq row 0)
(foreach data datalst
(setq row (1+ row)
colm -1
)
(foreach str data
(vla-setText tabela row (setq colm (1+ colm))
str
)
)
)
(vla-put-regenerateTableSuppressed tabela :vlax-false)
(princ)
)
(AddTable "TITLE" '(("ValueA0" "ValueA1"
"ValueA2"
)
("ValueB0" "sdfdsfsdsfsdf1"
"ValueB2" "ValueB3"
"ValueB4"
)
("ValueC0" "ValueC1"
"ValueC2" "ValueC3"
)
("Value5")
) 10
)

;;; 简单绘制表格 
(defun AddTable (Title datalst RowH / TableList-C2R datalst colms maxrow 
                       wlst tabela row colm i 
                ) 
  (defun TableList-C2R (lst n / l lst) 
    (setq l nil) 
    (repeat n 
      (setq l (cons (mapcar 
                      'car 
                      lst 
                    ) l 
              ) 
            lst (mapcar 
                  'cdr 
                  lst 
                ) 
      ) 
    ) 
    (reverse l) 
  ) 
  (setq datalst (mapcar 
                  '(lambda (y) 
                     (mapcar 
                       'vl-princ-to-string 
                       y 
                     ) 
                   ) 
                  datalst 
                ) 
        colms (length datalst) 
        maxrow (apply 
                 'max 
                 (mapcar 
                   'length 
                   datalst 
                 ) 
               ) 
        wlst (mapcar 
               '(lambda (x) 
                  (apply 
                    'max 
                    (mapcar 
                      '(lambda (y) 
                         (if y 
                           (strlen y) 
                           0 
                         ) 
                       ) 
                      x 
                    ) 
                  ) 
                ) 
               (TableList-C2R datalst maxrow) 
             ) 
        tabela (vla-addTable (vla-get-ModelSpace 
                                                 (vla-get-ActiveDocument 
                                                                         (vlax-get-acad-object) 
                                                 ) 
                             ) (vlax-3d-point (getpoint "\nPick a point to create the table.")) 
                             (1+ colms) maxrow RowH (* RowH 50) 
               ) 
  ) 
  (vla-put-regenerateTableSuppressed tabela :vlax-true) 
  (setq i -1) 
  (foreach w wlst 
    (vla-setcolumnwidth tabela (setq i (1+ i)) 
                        (* w RowH) 
    ) 
  ) 
  ; (vla-SetTextStyle tabela (+ acDataRow acHeaderRow acTitleRow) "样式 1") 
  (vla-SetTextHeight tabela acTitleRow (* 0.75 RowH)) 
  (vla-SetTextHeight tabela (+ acDataRow acHeaderRow) (* 0.5 RowH)) 
  (vla-setalignment tabela acDataRow acMiddleCenter) 
  (vla-setText tabela 0 0 Title) 
  (setq row 0) 
  (foreach data datalst 
    (setq row (1+ row) 
          colm -1 
    ) 
    (foreach str data 
      (vla-setText tabela row (setq colm (1+ colm)) 
                   str 
      ) 
    ) 
  ) 
  (vla-put-regenerateTableSuppressed tabela :vlax-false) 
  (princ) 
) 
(AddTable "TITLE" '(("ValueA0" "ValueA1" 
            "ValueA2" 
           ) 
           ("ValueB0" "sdfdsfsdsfsdf1" 
            "ValueB2" "ValueB3" 
            "ValueB4" 
           ) 
           ("ValueC0" "ValueC1" 
            "ValueC2" "ValueC3" 
           ) 
           ("Value5") 
          ) 10 
)

77077 · 发表于 2016-6-2 13:28:17

本帖最后由 77077 于 2016-6-2 13:33 编辑

再来一个line+text

;|简单绘制表格
参数：
Title 标题
datalst 表格型的数据
strh 字体高度
LAY 预设图层
备注：表格型数据需预先处理好，各行长度需相等
用法示例：
(AddlistTable "这是一个标题" '(
("Head11" "Head12" "Head13" "Head14")
("Value11" "Value12" "Value13" "Value14" "Value15" "Value16")
("ValueValue21" "Value22" "Value23" "Value24")
("Value31" "ValueValueValue32" "Value33" "Value34" "Value35")
("Value41" "Value42" "Value43" "Value44")
("Valuen" "Valuen" "Valuen" "ValueValueValueValuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
("Valuen" "Valuen" "Valuen" "Valuen")
)
5
"TABLE-表格"
)
|;
(defun AddlistTable (Title datalst strh lay / TableList-C2R datalst colms rows wlst PT startx starty endx endy enttable textptxlst nx textptylst ny)
(defun TableList-C2R (lst n / l lst)
(setq l nil)
(repeat n
(setq l (cons (mapcar 'car lst) l)
lst (mapcar 'cdr lst)
)
)
(reverse l)
)
(setq colms (length datalst);总行数
rows (apply 'max (mapcar 'length datalst));总列数
wlst (mapcar '(lambda(x)(apply 'max (mapcar '(lambda(y) (if y (strlen y) 0)) x)))(TableList-C2R datalst rows));各列最大字符串长度
wlst (mapcar '(lambda(x) (* (+ x 2) strh)) wlst);各列宽度
PT (getpoint "\n 指定表格左上角.");左上角
startx (car pt)
endx (+ startx (apply '+ wlst))
starty (cadr pt)
endy (- starty (* colms strh 2))
)
;绘制竖线,同时计算文字的X表
(setq textptxlst nil nx startx)
(entmake (list '(0 . "LINE") (cons 8 lay) (cons 10 (list nx starty 0.0)) (cons 11 (list nx endy 0.0))))
(foreach n wlst
(setq nx (+ nx n)
textptxlst (cons (- nx (* 0.5 n)) textptxlst)
)
(entmake (list '(0 . "LINE") (cons 8 lay) (cons 10 (list nx starty 0.0)) (cons 11 (list nx endy 0.0))))
)
(setq textptxlst (reverse textptxlst))
;绘制横线,同时计算文字的Y表
(setq textptylst nil ny starty)
(entmake (list '(0 . "LINE") (cons 8 lay) (cons 10 (list startx ny 0.0)) (cons 11 (list endx ny 0.0))))
(repeat colms
(setq ny (- ny strh)
textptylst (cons ny textptylst)
ny (- ny strh)
)
(entmake (list '(0 . "LINE") (cons 8 lay) (cons 10 (list startx ny 0.0)) (cons 11 (list endx ny 0.0))))
)
(setq textptylst (reverse textptylst))
(entmake (list '(0 . "TEXT") (cons 8 lay) (cons 1 title) (cons 10 (polar pt (* 0.5 pi) strh)) (cons 40 (* strh 1.5))))
;写出表格内容
(mapcar '(lambda(data pty)
(mapcar '(lambda(str ptx / pt)
(if (and str (/= str ""))
(progn
(setq pt (list ptx pty 0.0))
(entmake (list '(0 . "TEXT") (cons 8 lay) (cons 1 str)(cons 10 pt) (cons 40 strh) (cons 11 pt) (cons 72 1) (cons 73 2)))
)
);cond
)
data textptxlst
)
)
datalst textptylst
)
(princ)
)

;|简单绘制表格 
参数： 
Title    标题 
datalst  表格型的数据 
strh     字体高度 
LAY      预设图层 
备注：表格型数据需预先处理好，各行长度需相等 
用法示例： 
(AddlistTable "这是一个标题"  '( 
("Head11" "Head12" "Head13" "Head14") 
("Value11" "Value12" "Value13" "Value14" "Value15"  "Value16") 
("ValueValue21" "Value22" "Value23" "Value24") 
("Value31" "ValueValueValue32" "Value33" "Value34" "Value35") 
("Value41" "Value42" "Value43" "Value44") 
("Valuen" "Valuen" "Valuen" "ValueValueValueValuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
("Valuen" "Valuen" "Valuen" "Valuen") 
) 
5 
"TABLE-表格" 
) 
|; 
(defun AddlistTable (Title datalst strh lay / TableList-C2R datalst colms rows wlst PT startx starty endx endy enttable textptxlst nx textptylst ny) 
  (defun TableList-C2R (lst n / l lst) 
    (setq l nil)   
    (repeat n 
      (setq l (cons (mapcar 'car lst) l) 
        lst (mapcar 'cdr lst) 
      ) 
    ) 
    (reverse l) 
  ) 
  (setq colms (length datalst);总行数 
    rows (apply 'max (mapcar 'length datalst));总列数 
    wlst (mapcar '(lambda(x)(apply 'max (mapcar '(lambda(y) (if y (strlen y) 0)) x)))(TableList-C2R datalst rows));各列最大字符串长度 
    wlst (mapcar '(lambda(x) (* (+ x 2) strh)) wlst);各列宽度 
    PT (getpoint "\n 指定表格左上角.");左上角 
    startx (car pt) 
    endx (+ startx (apply '+ wlst)) 
    starty (cadr pt) 
    endy (- starty (* colms strh 2)) 
  ) 
  ;绘制竖线,同时计算文字的X表 
  (setq textptxlst nil nx startx) 
  (entmake (list '(0 . "LINE") (cons 8 lay) (cons 10 (list nx starty 0.0)) (cons 11 (list nx endy 0.0)))) 
  (foreach n wlst 
    (setq nx (+ nx n) 
      textptxlst (cons (- nx (* 0.5 n)) textptxlst) 
    ) 
    (entmake (list '(0 . "LINE") (cons 8 lay) (cons 10 (list nx starty 0.0)) (cons 11 (list nx endy 0.0)))) 
  ) 
  (setq textptxlst (reverse textptxlst)) 
  ;绘制横线,同时计算文字的Y表 
  (setq textptylst nil ny starty) 
  (entmake (list '(0 . "LINE") (cons 8 lay) (cons 10 (list startx ny 0.0)) (cons 11 (list endx ny 0.0)))) 
  (repeat colms 
    (setq ny (- ny strh) 
      textptylst (cons ny textptylst) 
      ny (- ny strh) 
    ) 
    (entmake (list '(0 . "LINE") (cons 8 lay) (cons 10 (list startx ny 0.0)) (cons 11 (list endx ny 0.0)))) 
  ) 
  (setq textptylst (reverse textptylst)) 
  (entmake (list '(0 . "TEXT") (cons 8 lay) (cons 1 title) (cons 10 (polar pt (* 0.5 pi) strh)) (cons 40 (* strh 1.5)))) 
  ;写出表格内容 
  (mapcar '(lambda(data pty) 
             (mapcar '(lambda(str ptx / pt) 
                        (if (and str (/= str "")) 
                          (progn 
                            (setq pt (list ptx pty 0.0)) 
                            (entmake (list '(0 . "TEXT") (cons 8 lay) (cons 1 str)(cons 10 pt) (cons 40 strh) (cons 11 pt) (cons 72 1) (cons 73 2))) 
                          ) 
                        );cond 
                      ) 
               data textptxlst 
             ) 
           ) 
    datalst textptylst 
  ) 
  (princ) 
)

77077 · 发表于 2016-6-2 17:00:58

自贡黄明儒发表于 2016-6-2 13:47
通常需要的table表不要第一行"TITLE"，删除哪个呀？

(entmake (list '(0 . "TEXT") (cons 8 lay) (cons 1 title) (cons 10 (polar pt (* 0.5 pi) strh)) (cons 40 (* strh 1.5))));写出表格title

xyp1964 · 发表于 2023-8-6 18:56:11

(defun c:tt ();普通直线和文本表格
(setq lst '(("ValueA0" "ValueA1" "ValueA2")
("ValueB0" "1000" "ValueB2" "ValueB3" "ValueB4")
("ValueC0" "ValueC1" "ValueC2" "ValueC3")
("Value5")
)
)
(xyp-TableAuto '(0 0) lst '("序号" "1" "2" "3" "4" "5"))
(princ)
)

USER2128 · 发表于 2016-6-2 10:55:59

谢谢楼主分享程序！

自贡黄明儒 · 发表于 2016-6-2 12:07:33

(*ERROR* "no function definition: VLA-PUT-REGENERATETABLESUPPRESSED")
你这个与版本有关吧？

77077 · 发表于 2016-6-2 13:03:54

自贡黄明儒发表于 2016-6-2 12:07
(*ERROR* "no function definition: VLA-PUT-REGENERATETABLESUPPRESSED")
你这个与版本有关吧？

删除这两行也影响不大，删除后慢了那么一点点点而已，关闭和打开表格的实时更新。

自贡黄明儒 · 发表于 2016-6-2 13:47:55

通常需要的table表不要第一行"TITLE"，删除哪个呀？

革天明 · 发表于 2016-6-2 13:51:04

楼主程序运行的结果如上表，我用arx练练手，结果中下表
bool CCreatEnt::YTMAddGrid(const AcGePoint3d &pt, int a,int b,double height,double width)
{
//a为几行，b为几列 height为行高，width为列宽
if(height==NULL || height==0)
{
height=2.5;
}
if(width==NULL || width==0)
{
width=10;
}
double x=b*width;
double y=a*height;
for(int i= 0;i<=a;i++)
{
AcGePoint3d pt1=CCreatEnt::PolarPoint(pt,CCreatEnt::PI()*1.5,i*height);
AcGePoint3d pt2=CCreatEnt::PolarPoint(pt1,0,x);
CCreatEnt::YTMAddLine(pt1,pt2);
}
for(int i= 0;i<=b;i++)
{
AcGePoint3d pt1=CCreatEnt::PolarPoint(pt,0,i*width);
AcGePoint3d pt2=CCreatEnt::PolarPoint(pt1,CCreatEnt::PI()*1.5,y);
CCreatEnt::YTMAddLine(pt1,pt2);
}
return true;
}

自贡黄明儒 · 发表于 2016-6-2 13:54:33

革天明发表于 2016-6-2 13:51
楼主程序运行的结果如上表，我用arx练练手，结果中下表
bool CCreatEnt::YTMAddGrid(const AcGePoint3d ...

高手呀，这么简洁。可惜我不懂arx,不然给你加点分

革天明 · 发表于 2016-6-2 14:17:57

自贡黄明儒发表于 2016-6-2 13:54
高手呀，这么简洁。可惜我不懂arx,不然给你加点分

这么说可让我惭愧呀！学习arx中，不知道写些什么，就对着练练手，由于版本为Lisp版块，除非题主给出CAD版本，否则我的回答对题主可是没有帮助的。

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

[函数] 简单绘制表格

评分

本帖被以下淘专辑推荐:

点评

评分

本帖子中包含更多资源

本帖子中包含更多资源

点评

评分