|
|
| Тема |
 Прехвърляне на текст от ACAD в Exel |
|
| Автор | StSt (Нерегистриран) | |
| Публикувано | 14.06.06 16:12 |
|
|
|
Предлагам програма за прехвърляне на текстови данни от ACAD в Excel
Програмата работи с тестове и Мтекстове подредени в колони. Трябва да се спазва подравняването по Y. При таблици с Мтекст трябва предварително да се гръмнат
;подготвя набор от текстове и ги прехвърля в Excel
(DEFUN to-clip (/ sp-clip sp2 i nab txt1 txt3 copyfile file en nn pt)
(if (setq sp-clip nil sp2 nil i 0 nab (ssget))
(progn
(REPEAT (SSLENGTH nab)
(setq en (ssname nab i)
i(1+ i)
pt (ASSOC 10 (entget en))
txt1 (ASSOC 1 (entget en))
txt3 (ASSOC 3 (entget en)))
(if txt1 (setq txt1 (cdr txt1))(setq txt1 ""))
(if txt3 (setq txt1 (strcat (cdr txt3) txt1)))
(if (and
txt1
(/= "" txt1)
);and
(progn
(WHILE (VL-STRING-SEARCH "\\P" txt1)
(setq txt1 (VL-STRING-SUBST "\n" "\\P" txt1))
);WHILE
(setq sp-clip (APPEND sp-clip (list (cons pt txt1))))
));if txt1
);REPEAT
(FOREACH nn(VL-SORT-I sp-clip '(LAMBDA (e1 e2)(< (nth 1(car e1))(nth 1(car e2)))))
(setq sp2 (APPEND sp2 (list (nth nn sp-clip))))
);FOREACH
(setq sp-clip sp2 sp2 nil)
(FOREACH nn(VL-SORT-I sp-clip '(LAMBDA (e1 e2)(> (nth 2(car e1))(nth 2(car e2)))))
(setq sp2 (APPEND sp2 (list (nth nn sp-clip))))
);FOREACH
(setq copyfile (strcat (VL-FILENAME-DIRECTORY (findfile "acad.exe"))"\\copyfile.xls")
file (open copyfile "w")
pt (caar sp2)
txt1 "")
(FOREACH nn sp2
(if (= (nth 2 (car nn))(nth 2 pt))
(setq txt1 (strcat txt1 (cdr nn)"\t"))
(progn
(WRITE-LINE txt1 file)
(setq txt1 (strcat(cdr nn)"\t") pt (car nn))
));if
);FOREACH
(WRITE-LINE txt1 file)
(CLOSE file)
(COMMAND "start" (strcat "Excel \""copyfile "\""))
);progn
);if nab
);to-clip
| |
| |
| 
|
|
