lisp画靶子 visual_简单绘制表格 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...

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

再来一个line+text[code="lisp]

;|简单绘制表格

参数：

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)

)[/code]