将文本从acad导出到excel
我需要一个lisp打开一个cad文件，并将文本从特定区域复制到excel表，然后用cad文件的名称保存excel文件，然后转到下一个acad文件。这些文本位于所有acad文件中的固定区域。在excel中保持行和列的顺序很重要。事实上，这些acad文件是从pdms导出的等轴测图形，我需要excel中每个图纸的bom表。非常感谢 干得好
;;----------------------------TOXL.LSP-------------------------------;;
;; fixo ()2013 * all rights released
;; 03/11/13
;; edited 5/13/13
(defun c:TOXL(/ *error* as col cp data elist en fname gkw newpath nextaddress
p1 p2 path rad row rownum setcelltext sheetname sset tmp
xlapp xlbook xlbooks xlcell xlcells xlrange xlsheet xlsheets)
(vl-load-com)
(defun *error* (msg)
(if
(vl-position
msg
'("console break"
"Function cancelled"
"quit / exit abort"
)
)
(princ "Error!")
(princ msg)
)
(princ)
)
(defun setcelltext(cells row column value)
(vl-catch-all-apply
'vlax-put-property
(list cells 'Item row column
(vlax-make-variant
(vl-princ-to-string value) ))
)
(if (and (setq p1 (getpoint "\nPick lower left point of area: "))
(setq p2 (getcorner p1"\nOpposite corner: "))
(setq sset (ssget "_W" p1 p2 (list (cons 0 "text");|(cons 8 "ANNO-TEXT")|)))
(while (setq en (ssname sset 0))
(setq elist (entget en))
(setq cp (cdr (assoc 10 elist)))
(setq txt (cdr (assoc 1 elist)))
(setq tmp (list txt (rtos (cadr cp)3 2) (rtos (cadr cp) 3 2)))
(setq data (cons tmp data))
(ssdel en sset)))
(setq sheetname (getstring T "\nEnter the label of an area (like Area#1) : "))
;;; main part
(if data
(progn
(setq data (append (list (list "Text" "X" "Y")) (reverse data)))
(alert "Wait...")
(setq xlapp (vlax-get-or-create-object "Excel.Application")
xlbooks(vlax-get-property xlapp 'Workbooks)
xlbook (vlax-invoke-method xlbooks 'Add)
xlsheets (vlax-get-property xlbook 'Sheets)
xlsheet (vlax-get-property xlsheets 'Item 1)
xlcells (vlax-get-property xlsheet 'Cells)
)
(vlax-put-property xlsheet "Name" sheetname)
(vla-put-visible xlapp :vlax-true)
(setq row 1)
(foreach dim data
(setq col 1)
(foreach i dim
(setcelltext xlcells row col (vl-princ-to-string i))
(setq col (1+ col)
)
)
(setq row (1+ row)
)
)
(vlax-invoke-method
(vlax-get-property xlsheet 'Columns)
'AutoFit)
(setq fname (strcat (getvar "dwgprefix")(vl-filename-base (getvar "dwgname"))".xls"))
(vlax-invoke-method
xlbook
'SaveAs
fname
nil
nil
nil
:vlax-false
:vlax-false
1
2
)
(vlax-invoke-method
xlbook 'Close)
(gc)
(vlax-invoke-method
xlapp 'Quit)
(mapcar '(lambda (x)
(vl-catch-all-apply
'(lambda ()
(vlax-release-object x)
)
)
)
(list xlcells xlsheet xlsheets xlbook xlbooks xlapp)
)
(setqxlapp nil)
(gc)(gc)
(alert (strcat "File saved as:\n" fname))
)
)
(*error* nil)
(princ)
)
(prompt "\n\t\t---\tStart command with TOXL\t---\n")
(prin1)
(or (vl-load-com)
(princ))
非常感谢，这个lisp很好，但它改变了行和列的顺序，在excel文件中保留上面的格式对我来说非常重要。如果你能再次编辑你的Lisp程序，我真的很感激。再次感谢你
图纸1.dwg 对不起，我能帮上更多的忙，太难解决了
页:
[1]