Клубове Дир.бг
powered by diri.bg
търси в Клубове diri.bg Разширено търсене

Вход
Име
Парола

Клубове
Dir.bg
Взаимопомощ
Горещи теми
Компютри и Интернет
Контакти
Култура и изкуство
Мнения
Наука
Политика, Свят
Спорт
Техника
Градове
Религия и мистика
Фен клубове
Хоби, Развлечения
Общества
Я, архивите са живи
Клубове Дирене Регистрация Кой е тук Въпроси Списък Купувам / Продавам 07:04 22.05.24 
Клубове/ Компютри и Интернет / CAD/CAM Всички теми Следваща тема Пълен преглед*
Информация за клуба
Тема Re: Спешен въпрос Аутокад2Ексел [re: Hямaм]
Автор Бaтe Бoйko ("Батето-2")
Публикувано09.12.05 15:17  



Е тия въпроси ги задавайте към Аутодеск.. Защо 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]


Цялата тема
ТемаАвторПубликувано
* Спешен въпрос Аутокад2Ексел Hямaм   21.10.05 13:06
. * Re: Спешен въпрос Аутокад2Ексел Penn Koff.   21.10.05 13:38
. * Re: Спешен въпрос Аутокад2Ексел Mинaвaщ   21.10.05 20:28
. * Re: Спешен въпрос Аутокад2Ексел *.*   17.12.05 13:26
. * Re: .... Mинaвaщ   18.12.05 01:39
. * Re: Спешен въпрос Аутокад2Ексел micro   24.10.05 09:55
. * Re: Спешен въпрос Аутокад2Ексел Бaтe Бoйko   09.12.05 15:17
. * Re: Спешен въпрос Аутокад2Ексел peshop   09.12.05 19:06
. * Re: Спешен въпрос Аутокад2Ексел peshop   09.12.05 19:09
. * Re: Спешен въпрос Аутокад2Ексел Бaтe Бoйko   12.12.05 16:31
Клуб :  


Clubs.dir.bg е форум за дискусии. Dir.bg не носи отговорност за съдържанието и достоверността на публикуваните в дискусиите материали.

Никаква част от съдържанието на тази страница не може да бъде репродуцирана, записвана или предавана под каквато и да е форма или по какъвто и да е повод без писменото съгласие на Dir.bg
За Забележки, коментари и предложения ползвайте формата за Обратна връзка | Мобилна версия | Потребителско споразумение
© 2006-2024 Dir.bg Всички права запазени.