求助,如何用lisp读取外部TXT文件,写入CAD自带的表格内.
如题,需要将外部txt格式的文件,读取后写入CAD自带的表格中,表格行数根据所读取的txt文件行数一致,列数为5列,插入表格时可以以窗口的形式插入(即表格对角两点可以拖拽选择表格范围,行宽,列宽以拖拽的表格范围确定,表格文字大小根据表格整体范围相应的缩小或者放大)把txt用Excel打开分好咧，复制黏贴至CAD中即可
直接从剪贴板中读取数据，不局限于Excel还是txt，免费使用
kozmosovia 发表于 2023-6-3 18:29
把txt用Excel打开分好咧，复制黏贴至CAD中即可
这样太麻烦了我是需要在lisp里操作生成. (lst2excel (txt2list (fn))) ;;表快速输出 XLS
(defun ls2xls (lst / _List:getRCXD::Excel:i2ColNoexcel bks acBook sht rccells range)
(defun XD::Excel:i2ColNo (a / l _i2ColNo)
(defun _i2ColNo (num / lst)
(cond
((<= 1 num 26) (setq lst (cons num lst)))
((> num 26) (setq lst (append (_i2ColNo (/ num 26)) (list (rem num 26)))))
(t lst)
) lst
)
(if (and (>= (setq a (fix (abs a))) 1)
(setq l (_i2ColNo a))
)
(apply 'strcat (mapcar '(lambda (x) (chr (+ 64 x))) l))
)
)
(setq excel (vlax-get-or-create-object "Excel.Application"))
(vla-put-visible excel :vlax-true)
(setq bks (vlax-get excel 'workbooks)
acBook (vlax-invoke bks 'Add)
sht(vlax-get excel 'ActiveSheet)
rc (strcat "A1:"
(xd::excel:i2ColNo (apply 'max (mapcar 'length lst)))
(itoa (length lst))
)
cells (vlax-get sht 'cells)
range (vlax-get-property cells 'Range rc)
)
(vlax-put-property range'value2
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbstring
(cons 1 (length lst))
(cons 1 (length (car lst)))
)
lst
)
)
;(vlax-put-property (vlax-get-property sht "Range" "A:A") "ColumnWidth" 20);列宽20
;(vlax-put-property (vlax-get-property sht "Range" "1:1") "RowHeight" 30);行高30
) (defun table:List (lst pt rowheight colwidth / tb i maxcol)
(setq tb (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
(vlax-3d-point pt)
(1+ (length lst))
(apply 'max (mapcar 'length lst))
rowheight
colwidth
)
)
(setq i 0)
(vla-setalignment tb acdatarow acmiddlecenter)
(mapcar '(lambda (x / j)
(setq i (1+ i)j -1)
(mapcar '(lambda (a) (vla-settext tb i (setq j (1+ j)) a)) x)
)
lst
)
)
给你参考下
;;---------------------=={ Add Table }==----------------------;;
;; ;;
;;Creates a VLA Table Object at the specified point, ;;
;;populated with title and data ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;space - VLA Block Object ;;
;;pt - Insertion Point for Table ;;
;;title - Table title ;;
;;data- List of data to populate the table ;;
;;------------------------------------------------------------;;
;;Returns:VLA Table Object ;;
;;------------------------------------------------------------;;
;;;;函数：LM:AddTable
;;;;功能：Add Table -by lee mac
;;;;示例：
;;(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
;; acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
;;)
;;
;;(LM:AddTable acspc (trans (getpoint) 1 0) "圆坐标统计" (cons '("标记" "直径" "X" "Y") data))
(defun LM:AddTable ( space pt title data / _isAnnotative textheight style )
(defun _isAnnotative ( style / object annotx )
(and
(setq object (tblobjname "STYLE" style))
(setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative")))))
(= 1 (cdr (assoc 1070 (reverse annotx))))
)
)
(
(lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
(
(lambda ( row )
(mapcar
(function
(lambda ( rowitem ) (setq row (1+ row))
(
(lambda ( column )
(mapcar
(function
(lambda ( item )
(vla-SetText table row (setq column (1+ column)) item)
)
)
rowitem
)
)
-1
)
)
)
data
)
)
0
)
table
)
(
(lambda ( textheight )
(vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) textheight
(* 0.8 textheight ;;文本高度
(apply 'max
(cons (/ (strlen title) (length (car data)))
(mapcar 'strlen (apply 'append data))
)
)
)
)
)
(* 1.2;;表格宽度
(/
(setq textheight
(vla-gettextheight
(setq style
(vla-item
(vla-item
(vla-get-dictionaries (vla-get-document space)) "ACAD_TABLESTYLE"
)
(getvar 'CTABLESTYLE)
)
)
acdatarow
)
)
(if (_isAnnotative (vla-gettextstyle style acdatarow))
(cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 ))
1.0
)
)
)
)
)
)
;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;
LPACMQ 发表于 2023-6-15 23:09
给你参考下
;;---------------------=={ Add Table }==----------------------;;
谢谢已经解决了
页:
[1]