求助,如何用lisp读取外部TXT文件,写入CAD自带的表格内.

丶吟游诗人灬 · 发表于 2023-6-3 13:39:19

如题,需要将外部txt格式的文件,读取后写入CAD自带的表格中,表格行数根据所读取的txt文件行数一致,列数为5列,插入表格时可以以窗口的形式插入(即表格对角两点可以拖拽选择表格范围,行宽,列宽以拖拽的表格范围确定,表格文字大小根据表格整体范围相应的缩小或者放大)

kozmosovia · 发表于 2023-6-3 18:29:01

把txt用Excel打开分好咧，复制黏贴至CAD中即可

革天明 · 发表于 2023-6-4 08:25:34

直接从剪贴板中读取数据，不局限于Excel还是txt，免费使用

丶吟游诗人灬 · 发表于 2023-6-5 10:59:05

kozmosovia 发表于 2023-6-3 18:29
把txt用Excel打开分好咧，复制黏贴至CAD中即可

这样太麻烦了我是需要在lisp里操作生成.

渠辉 · 发表于 2023-6-5 11:45:44

(lst2excel (txt2list (fn)))

渠辉 · 发表于 2023-6-5 11:57:35

;;表快速输出 XLS
(defun ls2xls (lst / _List:getRC XD::Excel:i2ColNo excel bks acBook sht rc cells 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
)

;;表快速输出 XLS 
(defun ls2xls (lst / _List:getRC  XD::Excel:i2ColNo  excel bks acBook sht rc  cells 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 
)

渠辉 · 发表于 2023-6-5 12:00:19

(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
)
)

LPACMQ · 发表于 2023-6-15 23:09:48

给你参考下

;;---------------------=={ 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                      ;;
;;------------------------------------------------------------;;

丶吟游诗人灬 · 发表于 2023-8-3 16:37:54

LPACMQ 发表于 2023-6-15 23:09
给你参考下

;;---------------------=={ Add Table }==----------------------;;

谢谢已经解决了

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

[提问] 求助,如何用lisp读取外部TXT文件,写入CAD自带的表格内.

本帖子中包含更多资源