Scribd
Upload
511 views6 pages

To Xls Lisp

The document contains two Lisp routines for exporting text from AutoCAD drawings to Excel spreadsheets. The first routine defines a function called txt2xl that loads the COM library, opens a CSV file, loops through selected MText and Text entities to extract their text strings, and writes these strings to the CSV file. The second, more advanced routine defines a function called txt2xls that loads the COM library, initializes Excel, prompts the user to select text using a window, sorts the selected text by X and Y coordinates, and writes the text strings and their positions to cells in an Excel worksheet.

Uploaded by

Logeswaran Raji
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
511 views6 pages

To Xls Lisp

The document contains two Lisp routines for exporting text from AutoCAD drawings to Excel spreadsheets. The first routine defines a function called txt2xl that loads the COM library, opens a CSV file, loops through selected MText and Text entities to extract their text strings, and writes these strings to the CSV file. The second, more advanced routine defines a function called txt2xls that loads the COM library, initializes Excel, prompts the user to select text using a window, sorts the selected text by X and Y coordinates, and writes the text strings and their positions to cells in an Excel worksheet.

Uploaded by

Logeswaran Raji
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 6

Re: Export Text To Excel

Options
06-15-2009 04:29 AM in reply to: parwez
Lisp One - By Lee Mac (http://www.cadtutor.net)
(defun c:txt2xl (/ fPath fName ofile doc ss)
(vl-load-com)
(setq fPath "C:\\")
(setq fName "test.csv")
(if (vl-file-directory-p fPath)
(progn
(setq ofile (open (strcat fPath fName) "a"))
(vlax-for doc (vla-get-Documents
(vlax-get-Acad-Object))
(if (setq ss (ssget "_X" '((0 . "MTEXT,TEXT"))))
(mapcar
(function
(lambda (x)
(write-line x ofile)))
(mapcar
(function
(lambda (x)
(cdr (assoc 1 (entget x)))))
(mapcar 'cadr (ssnamex ss)))))
(setq ss nil))
(close ofile))
(princ "\n Filename Does not Refer to Valid Directory "))
(princ))
______________________________________________________________________________
Lisp Two - By Pedro Miguel da Silva Ferreira (www.cadalyst.com)
;;;Cadalyst CAD Tips www.cadalyst.com/cadtips December 2008 (c) by the Author and
Cadalyst
;;;Author: Pedro Miguel da Silva Ferreira Email edro_ferreira@netcabo.pt or
pferreira@wsatkins.pt
;;;Web page: http://pwp.netcabo.pt/pedro_ferreira
;;;Location: Portugal, Lisboa
;;;RDS: PMSF
;;;Command Name: txt2xls
;;;Date: 10 of May 2008
;;;Version: 1.0
;;;Description: Visual Lisp Routine that writes to an excel file the selected text
(defun c:txt2xls ()
(vl-load-com)
(init-excel)

(selecttext)
(princ)
)
(defun selecttext ()
(princ "\nSelect text: ")
(setq pt1 (getpoint "\nSpecify first corner: "))
(setq pt2 (getcorner pt1 "Specify opposite corner:"))
(setq sstext (ssget "_w" pt1 pt2 '((0 . "text"))))
(setq lengthsstext (sslength sstext))
(setq count 0)
(setq textlist nil)
(repeat lengthsstext
(setq Text (vlax-ename->vla-object
(cdr (car (entget (ssname sstext count))))
)
TextPoint (vlax-get-property Text 'insertionpoint)
textString (vlax-get-property Text 'textstring)
listText (append
(vlax-safearray->list (vlax-variant-value textpoint))
(list textstring)
)
textlist (append textlist (list listtext))
count (1+ count)
)
)
(alert
"Length and Heigth error calculation, select two entities in the same column!"
)
(setq pt1 (vlax-safearray->list
(vlax-variant-value
(vlax-get-property
(vlax-ename->vla-object
(cdr (car (entget (car (entsel)))))
)
'insertionpoint
)
)
)
)
(setq pt2 (vlax-safearray->list
(vlax-variant-value
(vlax-get-property
(vlax-ename->vla-object
(cdr (car (entget (car (entsel)))))
)
'insertionpoint
)
)
)

)
(setq calY (- (abs (- (cadr pt1) (cadr pt2))) 0.001)
calX (- (abs (- (car pt1) (car pt2))) 0.001)
)
(setq
fuzzY (getreal
(strcat "\nHeigth error value <"
(rtos calY)
">, select other: "
)
)
)
(if (= fuzzY nil)
(setq fuzzY calY)
)
(setq
fuzzX (getreal
(strcat "\nLength error value <"
(rtos calX)
">, select other: "
)
)
)
(if (= fuzzX nil)
(setq fuzzX calX)
)
;;;ordenado por x
(setq textlist
(vl-sort textlist
(function (lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
)
(setq textlistlength (length textlist))
(setq count 0)
(setq countcol 1)
(while (< count textlistlength)
(progn
(setq smalllist (nth count textlist)
valuex (car (nth count textlist))
nextvaluex (car (nth (1+ count) textlist))
)
(setq smalllist (subst (itoa countcol) valuex smalllist))
(setq textlist (subst smalllist (nth count textlist) textlist))
(while (equal nextvaluex valuex fuzzX)
(progn

(setq count (1+ count))


(setq smalllist (nth count textlist)
valuex (car (nth count textlist))
nextvaluex (car (nth (1+ count) textlist))
)
(setq smalllist (subst (itoa countcol) valuex smalllist))
(setq
textlist (subst smalllist (nth count textlist) textlist)
)
(if (= nextvaluex nil)
(setq nextvaluex (1+ valuex))
)
)
)
(if (> nextvaluex valuex)
(progn
(setq count (1+ count))
(setq countcol (1+ countcol))
)
)
)
)
;;;ordenado por y
(setq textlist
(vl-sort textlist
(function (lambda (e1 e2)
(> (cadr e1) (cadr e2))
)
)
)
)
(setq textlistlength (length textlist))
(setq count 0)
(setq countrow 1)
(while (< count textlistlength)
(progn
(setq smalllist (nth count textlist)
valuey (cadr (nth count textlist))
nextvaluey (cadr (nth (1+ count) textlist))
)
(setq smalllist (subst (itoa countrow) valuey smalllist))
(setq textlist (subst smalllist (nth count textlist) textlist))
(while (equal nextvaluey valuey fuzzY)
(progn
(setq count (1+ count))
(setq smalllist (nth count textlist)
valuey (cadr (nth count textlist))
nextvaluey (cadr (nth (1+ count) textlist))
)

(setq smalllist (subst (itoa countrow) valuey smalllist))


(setq
textlist (subst smalllist (nth count textlist) textlist)
)
(if (= nextvaluey nil)
(setq nextvaluey (1+ valuey))
)
)
)
(if (< nextvaluey valuey)
(progn
(setq count (1+ count))
(setq countrow (1+ countrow))
)
)
)
)
(setq textlistlength (length textlist))
(setq count 0)
(while (< count textlistlength)
(progn
(setq colstring (cadddr (nth count textlist)))
(setq posx (atoi (car (nth count textlist)))
posy (atoi (cadr (nth count textlist)))
)
(write-row-column posy posx colstring)
(setq count (1+ count))
)
)
(princ)
)
;;;-------------------;;;
(defun init-excel (/ excel-app wb-collection workbook sheets sheet1)
(setq excel-app (vlax-create-object "excel.application"))
(setq wb-collection (vlax-get excel-app "workbooks"))
(setq workbook (vlax-invoke-method wb-collection "add"))
(setq sheets (vlax-get workbook "sheets"))
(setq sheet1 (vlax-get-property sheets "item" 1))
(setq *excel-cells* (vlax-get sheet1 "cells"))
(vlax-put excel-app "visible" 1)
)
(defun write-row-column (row col x)
(vlax-put-property
*excel-cells*
"item"
row
col

(vl-princ-to-string x)
)
)
(alert
"Type [txt2xls] in the command line\n\nAuthor: Pedro Ferreira\nweb page:
http://pwp.netcabo.pt/pedro_Ferreira\n\nTHIS PROGRAM IS PROVIDED \"AS IS\" AND
WITH ALL FAULTS.\n\nPress OK to continue."
)
_________________________________________________________________________

You might also like

pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy