Lisp绘制表格
2010-09-11 22:41阅读：
基本思路：
读取数据－获取列数－获取每列文字最多个数确定列宽
－根据单元格上下左右边距计算表格线坐标和文字坐标
－在0,0点生成表格
－将生成的表格写成块，插入
－插入完成后将块转为匿名块
注：
表格是根据单元格四周边距计算位置，核心是ccCreateTable函数，因此根据需要提供参数即可。
CAD本身直接可从Excel生成表格：在Excel选中数据copy，CAD中Edit菜单－Paste Special－Auto CAD
Entities即可，很方便。
;;; 公共变量
(setq pbPLClose 'Y') ;多义线是否封闭开关变量
(setq pLastFilePath 'E:\\pData\\') ;默认打开文件目录
;;;-------------------
;;; CCTB
;;; By Chaos
;;;-------------------
;;; 根据逗号分隔文本文件创建表格
(defun c:CCTB( / oldOSMODE FileName tbTitle)
(vl-load-com)
(setq oldOSMODE (getvar 'OSMODE'))
(setvar 'OSMODE' 0)
(setvar 'CMDECHO' 0)
(setq oldCL (getvar 'CLAYER'))
(if (= pLastFilePath nil) (setq
pLastFilePath '
'))
(setq FileName (getfiled '选择坐标数据文件'
pLastFilePath 'txt' 2))
(setq pLastFilePath (car (ccGetFilePath
FileName '\\')))
;表格标题
(setq tbTitle (nth 1 (ccGetFilePath
FileName '\\')))
(setq tbTitle (substr tbTitle 1 (- (strlen
tbTitle) 4)))
(setq tbTitle (strcat 'Table: '
tbTitle))
(setq DataList (ccReadFile FileName ',' 'S'
0)) ;读取数据
;;; (setq DataList (cons (list 'No.' 'X'
'Y' 'Z' 'M' 'N' 'No.' 'X' 'Y' 'Z' 'M' 'N')
;;;
DataList
;;;
)
;;; );添加表头,个数与数据列数相同
(command '.undo' 'be')
(ccCreateTable DataList '' 2.0 2.0 2.0 2.0
tbTitle 2 2.5 0.0 '') ;创建表格'(10 10 0)
(command '.undo' 'e')
(setvar 'CLAYER' oldCL)
(setvar 'OSMODE' oldOSMODE)
(setvar 'CMDECHO' 1)
(princ)
)
;;;===================
;;; 子函数
;;;===================
;;;------------------------------------
;;; ccCreateTable: 创建表格，字高1
;;;------------------------------------
;;; DataList: 数据列表
;;; TxtAlign：文字对齐方式，L:左对齐，R：右对齐，C：居中对齐
;;; cellPadLft cellPadRig cellPadTop cellPadBot 单元格左右上下边距
;;; tbTitle: 表格标题
;;; tbHeight：表格标题字体高度
;;; gapTitle: 标题底线与表格距离
;;; lineExtDist: 标题底线两端出露文字距离,可为负
(defun ccCreateTable(DataList TxtAlign cellPadLft cellPadRig
cellPadTop cellPadBot
tbTitle hTitle gapTitle lineExtDist
InsPoint /
data ColTxtNum tmpColTxtNum nRow
nCol i j tbWidth tbHeight
rowHeight colWidth xPos xCol
ptStart ptEnd ptTxt tbStart tbNext ssTB
)
(setq nRow (1- (length DataList) ) nCol (1-
(length (car DataList)) ) )
(setq i 0)
(setq ColTxtNum '())
(while (<= i nCol)
(setq ColTxtNum (cons 0 ColTxtNum))
(setq i (1+ i))
)
;获取每列最大字符数
(setq i 0)
(while (<= i nRow)
(setq j 0)
(setq tmpColTxtNum '())
(while (<= j nCol)
(setq tmpColTxtNum (cons
(max (nth j ColTxtNum) (strlen (nth j (nth
i DataList))) )
tmpColTxtNum
)
)
(setq j (1+ j))
)
(setq
ColTxtNum (reverse tmpColTxtNum))
;;; (princ ColTxtNum) (princ '')
(setq i (1+ i))
)
;获取表格宽、表格高、列宽
(setq j 0)
(setq tbWidth 0.0)
(while (<= j nCol)
(setq
tbWidth (+ (+ cellPadLft (nth j ColTxtNum) cellPadRig) tbWidth)
)
(setq
colWidth (cons (+ cellPadLft (nth j ColTxtNum) cellPadRig)
colWidth))
(setq j (1+
j))
)
(setq colWidth (reverse colWidth))
(setq tbHeight 0.0)
(setq tbHeight (* (1+ nRow) (+ cellPadTop 1
cellPadBot)) )
(setq rowHeight (+ cellPadTop 1
cellPadBot))
;获取每列的x坐标
(setq j 1)
(setq xCol (list 0.0))
(while (<= j nCol)
(setq i
0)
(setq xPos
0.0)
(while
(< i j)
(setq xPos (+ (nth i colWidth) xPos))
(setq i (1+ i))
)
(setq xCol
(cons xPos xCol))
(setq j (1+
j))
)
(setq xCol (reverse xCol))
(setq ssTB (ssadd)) ;表格选择集
;表标题
(command 'Text' 'J' 'BC' (list (/ tbWidth
2) (+ gapTitle 0.7)) hTitle 0 tbTitle)
(setq tbStart (entlast))
(ssadd tbStart ssTB)
(command 'PLine'
(list (- (/ tbWidth 2) (/ ( *
(strlen tbTitle) hTitle) 2) lineExtDist) (+ gapTitle 0.4))
'w' 0.1 0.1
(list (+ (/ tbWidth 2) (/ ( *
(strlen tbTitle) hTitle) 2) lineExtDist) (+ gapTitle 0.4))
''
)
(command 'Line'
(list (- (/ tbWidth 2) (/ ( *
(strlen tbTitle) hTitle) 2) lineExtDist) gapTitle)
(list (+ (/ tbWidth 2) (/ ( *
(strlen tbTitle) hTitle) 2) lineExtDist) gapTitle)
''
)
;画表格线
;横线
(setq i 1)
(while (<= i nRow)
(setq
ptStart (list 0.0 (- 0.0 (* i rowHeight))))
(setq ptEnd
(list (+ 0.0 tbWidth) (- 0.0 (* i rowHeight))))
(command
'Line' ptStart ptEnd '')
(setq i (1+
i))
)
;纵线
(setq j 0)
(while (<= j nCol)
(setq
ptStart (list (nth j xCol) 0.0));(* j (nth j colWidth))
(setq ptEnd
(list (nth j xCol) (- tbHeight)))
(command
'Line' ptStart ptEnd '')
(setq j (1+
j))
)
;表格边框
(command 'PLine'
'(0 0) 'W' 0.0 0.0
(list tbWidth 0)
(list tbWidth (- tbHeight))
(list 0.0 (- tbHeight))
'C'
)
;文字ptTxt
(setq i 0)
(while (<= i nRow)
(setq j
0)
(while
(<= j nCol)
(cond
((= 'L'
TxtAlign)
(setq ptTxt
(list
(+ (nth j xCol) cellPadLft)
(- (* i (- rowHeight))
cellPadTop 0.5)
)
)
(command 'TEXT' 'J' 'ML' ptTxt 1 0 (nth j
(nth i DataList)) )
)
((= 'R'
TxtAlign)
(setq ptTxt
(list
(- (+ (nth j xCol) (nth j colWidth)
) cellPadRig)
(- (* i (- rowHeight))
cellPadTop 0.5)
)
)
(command 'TEXT' 'J' 'MR' ptTxt 1 0 (nth j
(nth i DataList)) )
)
(T
(setq ptTxt
(list
(+ (nth j xCol) (/ (nth j colWidth)
2))
(- (* i (- rowHeight))
cellPadTop 0.5)
)
)
(command 'TEXT' 'J' 'MC' ptTxt 1 0 (nth j
(nth i DataList)) )
)
)
(setq j (1+ j))
)
(setq i (1+
i))
)
;选择集
(setq tbNext (entnext tbStart))
(while tbNext
(ssadd
tbNext ssTB)
(setq
tbNext (entnext tbNext))
)
;制作块
(ccMakeBlock ssTB 'tempTB' '(0.0 0.0 0.0)
T)
(setq InsPoint nil)
(if (or (= nil InsPoint) (= ''
InsPoint))
(command
'Insert' 'tempTB' pause 1.0 1.0 0.0)
(command
'Insert' 'tempTB' InsPoint 1.0 1.0 0.0)
)
(ccAnonymousBlock) ;改为匿名块
(princ '')
)
;; Make a block from a selection set. Arguments are the selection
set,
;; a string contianing the name of the block, a list of three
numbers
;; defining the insertion point, and a flag (NIL to leave the
original
;; entities in the drawing, non-NIL to delete the original
entities).
(DEFUN ccMakeBlock(SelSet BlockName InsertPoint DeleteEntitiesFlag
/ Counter)
(ENTMAKE (LIST '(0 . 'BLOCK')
(CONS 2 BlockName)
'(8 . '0')
'(70 . 0)
(APPEND (LIST 10) InsertPoint)
)
)
(SETQ Counter (SSLENGTH SelSet))
(WHILE (<= 0 (SETQ Counter (1-
Counter)))
(ENTMAKE
(StripDXFPairs (ENTGET (SSNAME SelSet Counter))))
(IF
DeleteEntitiesFlag
(ENTDEL (SSNAME SelSet Counter))
)
)
(ENTMAKE '((0 . 'ENDBLK')))
)
;; Strip the DXF pairs not allowed in an entmake call from an
;; Entity Association List. Returns the EAL minus the
stripped
;; pairs.
(DEFUN StripDXFPairs (EList / CodesToStrip ReturnList)
(SETQ CodesToStrip '(5))
(FOREACH DXFPair EList
(IF (NOT
(MEMBER (CAR DXFPair) CodesToStrip))
(SETQ ReturnList (CONS DXFPair
ReturnList))
)
)
(REVERSE ReturnList)
)
;;;-----------------
;;; 改为匿名块
;;;-----------------
(defun ccAnonymousBlock (/ tt apple_sel apple_nnblk)
(vl-load-com)
(SETQ apple_nnblk
(VLAX-ENAME->VLA-OBJECT (entlast))) ; (car (entsel))
(IF (= (VLA-GET-OBJECTNAME apple_nnblk)
'AcDbBlockReference')
(PROGN
(VLA-PUT-NAME
(VLA-ITEM
(VLA-GET-BLOCKS
(VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT))
)
(VLA-GET-NAME apple_nnblk)
)
'*U'
)
)
(PRINC
'错误：选择物体非块！')
)
(princ)
)
;;;----------------------
;;; ccGetFilePath
;;;----------------------
;;; 获取文件路径和文件名
;;; sFileName: 完整文件名
;;; sDelim 路径分隔符'/'或'\\'
(defun ccGetFilePath(sFileName sDelim / tmpStr tmpPos Pos fPath
fName)
(vl-load-com)
(setq tmpStr sFileName)
(setq Pos 0)
(while (setq tmpPos (vl-string-search
sDelim tmpStr))
(setq
tmpStr (substr tmpStr (+ tmpPos 2)))
(setq Pos
(+ pos tmpPos 1))
)
(setq fName tmpStr)
(setq fPath (substr sFileName 1 pos))
(list fPath fName)
)
;;;-------------------
;;; ccReadFile
;;;-------------------
;;; ccReadFile: 读取数据文件，返回DataList
;;; FileName: 完整文件名
;;; sDelim: 数据分隔符
;;; sRtnMode: 返回值模式，D,d为数据，S,s为字符串
(defun ccReadFile(FileName sDelim sRtnMode nStartLine /
DataList ff Data rowData posDelim nLine)
(setq DataList '())
(setq ff (open FileName 'r'))
(setq Data (read-line ff))
(setq nLine 1)
(cond
((or (= 'D'
sRtnMode) (= 'd' sRtnMode))
(while Data
(if (>
nLine nStartLine)
(progn
(setq
rowData '())
(while
(setq posDelim (vl-string-search sDelim Data))
(setq rowData (cons (read (substr Data 1
posDelim)) rowData))
(setq Data (substr Data (+ posDelim
2)))
)
(setq
rowData (reverse (cons (read Data) rowData)))
(setq
DataList(cons rowData DataList))
)
)
(setq Data
(read-line ff))
(setq nLine
(1+ nLine))
)
(setq DataList (reverse DataList))
)
((or (= 'S'
sRtnMode) (= 's' sRtnMode))
(while Data
(if (>
nLine nStartLine)
(progn
(setq
rowData '())
(while
(setq posDelim (vl-string-search sDelim
Data))
(setq rowData (cons (substr Data 1
posDelim) rowData))
(setq Data (substr Data (+ posDelim
2)))
)
(setq
rowData (reverse (cons Data rowData)))
(setq
DataList(cons rowData DataList))
)
)
(setq Data
(read-line ff))
(setq nLine
(1+ nLine))
)
(setq DataList (reverse DataList))
)
)
(close ff)
DataList
)
(if C:CCTB
(princ 'CCTB: 创建表格')
(princ 'CCTB加载失败，请重新加载!')
)
(princ '请输入: CCTB运行')
