Re: Спешен въпрос Аутокад2Ексел / Компютри и Интернет / CAD/CAM

Е тия въпроси ги задавайте към Аутодеск.. Защо 15 години хората пишат елементарни лиспове, които да вършат елементарни неща, които съвсем просто е можело някоя дървена глава от Аутодеск да направи за 15 минути !! Поне лисповете от 80-те да ги вкарат в стандартния аутокад..

А иначе - как точно ги искаш в ексела? В коя клетка? Как да са подредени тектсовете? работата е мнооого сложна, и затова в последните 10 версии още не могат да я направят. :-)

Иначе пробвай с това:

;; CSVOUT.LSP Copyright 2000 Tony Tanzillo All rights reserved.
;;
;; Adds CSVOUT command to AutoCAD, which exports selected
;; tablular text to .CSV format.
;;

(defun list-index (input func / i)
(setq i -1)
(mapcar 'cdr
(vl-sort
(mapcar
'(lambda (val)
(cons val (setq i (1+ i)))
)
input
)
'(lambda (a b)
(apply func (mapcar 'car (list a b)))
)
)
)
)

(defun ss-index (ss _getKey _compareKey / keylist i)
(repeat (setq i (sslength ss))
(setq keylist
(cons
(apply _getKey (list (ssname ss (setq i (1- i)))))
keylist
)
)
)
(list-index keylist _compareKey)
)

(defun compare-points (p1 p2)
(if (equal (cadr p1) (cadr p2) epsilon)
(< (car p1) (car p2))
(> (cadr p1) (cadr p2))
)
)

(defun Strlcat (delim strlst)
(apply 'strcat
(cons
(car strlst)
(mapcar
'(lambda (s)
(strcat delim s)
)
(cdr strlst)
)
)
)
)

(defun list->string (lst)
(strlcat ","
(mapcar
'(lambda (s)
(if (numberp s)
(rtos s)
(strcat (chr 34) s (chr 34))
)
)
lst
)
)
)

(defun C:CSVOUT ( / ss indices oldtext epsilon colcnt rowcnt count j e tmp y table outfile text-point)
(defun text-point (ename / d)
(if (eq 2 (cdr (assoc 72 (setq d (entget ename)))))
(cdr (assoc 11 d))
(cdr (assoc 10 d))
)
)
(setq epsilon (/ (getvar "TEXTSIZE") 20.0))
(setq ss (ssget '((0 . "TEXT"))))
(if (or (not ss) (< (sslength ss) 2))
(progn
(alert "Must select a rectangular array of text.")
(exit)
)
)
(setq indices (ss-index ss 'text-point 'compare-points))
(setq colcnt 0)
(setq y (caddr (assoc 10 (entget (ssname ss (car indices))))))
(while (equal y (caddr (assoc 10 (entget (ssname ss (nth (setq colcnt (1+ colcnt)) indices))))) epsilon))
(if (zerop colcnt)
(progn (alert "\nNo columns detected.") (exit))
)
(setq count (length indices))

(if (not (zerop (rem count colcnt)))
(progn
(alert
(strcat
"\nTotal number of text items (" (itoa count) ") must be an even "
"\nmultiple of the number of detected columns ("
(itoa colcnt) ")"
)
)
(exit)
)
)

(princ
(strcat
"\nDetected table of " (itoa count) " items ("
(itoa colcnt) " columns x " (itoa (setq rowcnt (/ count colcnt)))
" rows)."
)
)

(setq i count)
(repeat rowcnt
(setq row nil)
(repeat colcnt
(setq row (cons (cdr (assoc 1 (entget (ssname ss (nth (setq i (1- i)) indices))))) row))
)
(setq table (cons row table))
)

(setq table
(mapcar 'list->string
(apply 'mapcar
(cons 'list
(mapcar
'(lambda (column / numbers)
(if (apply 'and (setq numbers (mapcar 'distof column)))
numbers
column
)
)
(apply 'mapcar (cons 'list table))
)
)
)
)
)

(if (setq outfile (getfiled "Export table text to CSV" "" "csv" 1))
(progn
(setq fd (open outfile "w"))
(mapcar '(lambda (line) (write-line line fd)) table)
(close fd)
)
)

(princ)
)

(defun lsort (input OnCompare / fun)
(setq fun (cond (OnCompare) (t '>)))
(lsort-aux input)
)

(if (not vl-sort)
(setq vl-sort lsort)
)

(defun lsort-aux (input)
(if (cdr input)
( (lambda (tlist)
(lsort-merge
(lsort-aux (car tlist))
(lsort-aux (cadr tlist))
)
)
(lsort-split input)
)
input
)
)

(defun lsort-split (right / left)
(repeat (/ (length right) 2)
(setq
left (cons (car right) left)
right (cdr right)
)
)
(list left right)
)

(defun lsort-merge (left right / out)
(while (and left right)
(if (apply fun (list (car left) (car right)))
(setq
out (cons (car left) out)
left (cdr left)
)
(setq
out (cons (car right) out)
right (cdr right)
)
)
)
(append (reverse out) left right)
)

[bateto] [got mi е] [/bateto]

Public Sub TextToExcel()
Dim intRow As Integer, strCell As String
Dim oExcel As Excel.Application, oBook As Excel.Workbook, _
oSheet As Excel.Worksheet
Dim obj As AcadEntity, objText As AcadText
Dim varInsert As Variant
Dim i As Integer
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
oExcel.Visible = True
intRow = 1
For Each obj In ThisDrawing.ModelSpace
If TypeOf obj Is AcadText Then
Set objText = obj
oExcel.Cells(intRow, 1).Value = objText.TextString
varInsert = objText.InsertionPoint
intRow = intRow + 1
End If
Next obj
End Sub