Нужна програмка для спецификации

Нютка · 27.03.2007, 17:38

Нужна програмка для создания спецификации оборудования.
Вопрос в следующем:
есть план с расстановкой оборудования и номерами позиций. Позиции находятся на трёх слоях и представляют собой однострочный текст.
Необходимо подсчитать количество этих позиций оборудования. Желательно, чтобы данные перенеслись в Excel, и представляли собой два столбца: 1 - номер позиции, 2 - количество.
Помогите, а то я в программировании - ни бум-бум :cry:
Заранее благодарю

lee · 27.03.2007, 18:19

попробуй EATTEXT

Rost · 27.03.2007, 18:31

Это можно лекго пересчитать средствами автокада.
Например через быстрое выделение:
Quick Select, там настраиваешь искать текст по содержанию, и указываешь содержание. Когда все позиции выделились, их становится видно, можно пересчитать визуально или вызвать панель свойств, там в списке указанно число выделенных обьектов.

Исчо можно попробовать Filter, в нем также можно отсеять то, что нужно, только в выделенной области чертежа.

в 2008 автокаде есть мазовая связь с экселем. В настройке таблиц. Проблема лишь в заполнении таблицы, пересчитать все не трудно.

lee · 27.03.2007, 19:17

Цитата:

Сообщение от Rost

Это можно лекго пересчитать средствами автокада.

EATTEXT это встроенная команда AutoCAD. Именно то, что доктор прописал.

Нютка · 28.03.2007, 09:52

Спасибо, что отклинулись, но нужно чуть-чуть другое. Эта команда, во первых выбирает всё, а во-вторых она не считает количество, а если учесть, что планы огромные и позиция может повторяться раз по 100, то потом считать - это долго.
В общем у меня есть одна програмка, написанная очень умным человечком, но нужно её подредактировать:

И вот что надо:
выборку нужно произвести на слоях:технология, вода, электрика. В данном случае, нужно три раза произвести операцию. А можно ли, чтобы позиции на этих слоях выбирались сразу, за один приём.
И ещё. Итог переводится в файл .txt, а хотелось бы в Excel.

Спасибо

Alan · 28.03.2007, 10:13

>Нютка

Цитата:

Спасибо, что отклинулись, но нужно чуть-чуть другое. Эта команда, во первых выбирает всё, а во-вторых она не считает количество, а если учесть, что планы огромные и позиция может повторяться раз по 100, то потом считать - это долго....

Программа, которую Вы применяете, недалеко ушла от тех средств,
которые Вам предложили: BCOUNT, EATTEXT (кстати с очень большими возможностями)..., я бы назвал еще несколько.
Но! Спецификацию она не делает!
Посмотрели бы поиском на этом и соседнем форумах, нашли бы много интересного...
Чтобы не повторяться, т.к. писал на эту тему неоднократно, вот одна ссылка http://www.autocad.ru/cgi-bin/f1/board.cgi?t=17698zE
См. >Alan (2005-07-06 17:43:35)

Цитата:

В двух словах.
1.Используем для чертежей Акад 200х. Блоки оборудования имеют код марки, остальная информация в базе.
2.База проектов и оборудования реализована на MS Acces.
3.Позволяется прогой считать с указанного чертежа (через СОМ-сервер) количество и марки блоков или дополнить в итерактивном режиме при работе программы с базой оборудования.
4.Генератор отчета формирует по объекту и заголовкам спецификацию. Можно на принтер или в pdf.
5.Инструкция 16 стр., считая вместе с титулом. Так что можно прочесть.
Если что-то не понятно пишите.
Выслал Вам скриншоты и образец выходного документа.

Profan · 28.03.2007, 10:18

Для Нютка.
Нютка, ай-я-яй.
Владимир Громов aka Profan.

Mercury · 28.03.2007, 11:04

Mercury · 28.03.2007, 11:07

Надобыло сразу думать.
Оборудывание сделать блоками, к ним присоединить отрибуты.Наименование и позиция, а потом все это извлеч в ексель и там обработать, можно даже позиции поставить автоматом потом когда будешь возвращать атрибуты на место.

Rost · 28.03.2007, 11:15

Цитата:

Сообщение от Нютка

Спасибо, что отклинулись, но нужно чуть-чуть другое. Эта команда, во первых выбирает всё, а во-вторых она не считает количество, а если учесть, что планы огромные и позиция может повторяться раз по 100, то потом считать - это долго.
В общем у меня есть одна програмка, написанная очень умным человечком, но нужно её подредактировать:

И вот что надо:
выборку нужно произвести на слоях:технология, вода, электрика. В данном случае, нужно три раза произвести операцию. А можно ли, чтобы позиции на этих слоях выбирались сразу, за один приём.
И ещё. Итог переводится в файл .txt, а хотелось бы в Excel.

Спасибо

Стандартными средствами все это делается без проблем, все пересчитать, рассортировать хоть по слоям хоть из слоев как угодно можно в автокаде стандартными средствами. Т.к. можно все фильтровать по многим параметрам, (по цвету, по слою, по имени, по содержанию, по длине и т.д. и т.п.) что исчо нужно????

Гы.....
Кароче нужна прога которая сама все сделает!?!?!? Так я понимаю?
Чем станадартные средства не устраивают, не пойму???
Кучу домов общитывал, даже жилые комплексы 40 000 - 60 000м.кв., Там сотни и тысячи всяких эллементов, и енти сотни разбиты исчо на подгруппы, кроме эллеменов исчо площади и обьемы всего что можно обмерять, все эти безконечные спецификации и сводные без особого труда делаются и составляются стандартными средствами и ЭКСЕЛЕМ.

ПЫСЫ
Про EATTEXT не слыхал, ща поюзаю.

Нютка · 28.03.2007, 11:33

для Rost
Да можно, конечно, отсортировать! Но мне надо, чтобы выбирались элементы сразу на трёх слоях, а не по очереди!

для Mercury
А по поводу атрибутов........... Хорошая вещь, но к сожалению не могу до конца разобраться.
AutoCad изучала методом тыка, поэтому многого не знаю.
Когдя пришла работать, тут вообще всё вручную считали, поэтому на тот момент что могла, то и сделала. А сейчас у меня около 500 позиций отрисовано и переделывать - ну очень долго.

Ну скажите: как выбрать элементы сразу на трёх слоях?

VVA · 28.03.2007, 11:44

>Profan №7 Ну вот, даже не успел посмотреть хорошую программу хорошего человека

>Нютка Как использовать лисп с форума (если не знаешь)
http://dwg.ru/pub/9

Код:

[Выделить все]

;|================== XLS ========================================
* Опубликовано http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31371zf
               http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31596eW
* Автор: Владимир Азарко aka VVA. МинскИнжПроект
* Назначение: Печать списка данных DataList в Excell
*             Вывод осуществляется в текущю книгу в новый лист. Если нет, то создается новая книга
              Вывод осуществляется в новом листе
* Аргументы:
              DataList - список списков данных (LIST) вида
                            ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                            Каждый список вида (Value1 Value2 ... VlalueN) записывается
                            в отдельную строку в соответствующие столбцы (Value1-A Value2-B и .т.д.)
                  header -  список (LIST) заголовков или nil вида ("Подпись A" "Подпись B" ...)
                            Если header nil, принимается ("X" "Y" "Z")
                 Colhide -  список буквенных названий стоблцов для скрытия или nil - не скрывать
                            ("A" "C" "D") - скрыть столбцы A, C, D
                 Name_list - имя нового листа активной книги или nil - новая книга
* Возврат: nil
* TIPS!!! : При передачи функции xls числовых вещественных данных нет необходимости проверять текущий системный
            разделитель целой и дробной части ("HKEY_CURRENT_USER\\Control Panel\\International" "sDecimal")
            Функцией на время вывода отключается использование в Excele системного разделителя, разделителем
            целой и дробной части устанавливается точка. После завершения ф-ции все восстанавливается.
Пример вызова
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Столбец1" "Столбец2" "Столбец3" "Столбец4") '("B"))|;
(vl-load-com)
(defun xls ( DataList header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26) 
  TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
  Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))   
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
  (if (setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
              *New-Book*     (vlax-invoke-method *Books-Colection* "Add")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
                  (vl-filename-base(getvar "DWGNAME"))
                  (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
   col 0 cols nil)
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)  
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)    
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))  
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_не использовать системные установки
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            ;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          ;_разделитель тысячей
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq  row 2 col 1)
(repeat (length DataList)(setq iz_listo (car DataList))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq DataList (cdr DataList))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
	  (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))  
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))  
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
	  (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))    
(vlax-put-property cols 'hidden 1)  
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)  
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))

;|============================================================================= 
*    Функция преобразования набора, полученного через (ssget), в список 
* ename-примитивов. 
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA.
*    Параметры вызова: 
*   selset   набор примитивов 
*    Примеры вызова: 
(lib:selset-to-enamelist (ssget)) 
=============================================================================|; 
(defun lib:selset-to-enamelist (selset) 
(if selset (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))))

;|============================================================================= 
*    Функция преобразования набора, полученного через (ssget), в список 
* vla-примитивов.
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA.
*    Параметры вызова: 
*   selset   набор примитивов 
*    Примеры вызова: 
(lib:selset-to-vlalist (ssget)) 
=============================================================================|; 
(defun lib:selset-to-vlalist(selset) 
(if selset (mapcar 'vlax-ename->vla-object(lib:selset-to-enamelist selset))))

;| ===== mip_MakeUniqueMembersOfListWithCount =====
* Удаляет одинаковые (дубликаты) элементы из списка
* с подсчетом числа вхождений элемента
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA.
* Пример вызова: 
(mip_MakeUniqueMembersOfListWithCount '( 1 2 3 1 2 3 1 1 2 2))
* Вернет ((1 . 4) (2 . 4) (3 . 2)) |;
(defun mip_MakeUniqueMembersOfListWithCount  ( lst / OutList head count)
  (while lst
    (setq head (car lst)
	  count 0
          lst (vl-remove-if '(lambda(pt)(if (equal pt head 1e-6)(setq count (1+ count)) nil)) lst)
          OutList (append OutList (list (cons head count)))))
  OutList
  )


(defun C:Нютка ( / laylist pat ss DataList)
  (vl-load-com)
  (setq laylist '("Технология" "Вода" "Электрика")) ;;<<Список слоев для выборки
  (setq pat (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) laylist)))
  (if (setq ss (ssget "_X" (list '(0 . "TEXT")(cons 8 pat))))
    (progn
      (setq DataList (mapcar 'vla-get-textstring
                             (lib:selset-to-vlalist ss))
            DataList (mip_MakeUniqueMembersOfListWithCount DataList)
            )
      (setq DataList (mapcar '(lambda(x)(list (car x)(cdr x))) DataList))
      (setq DataList (vl-sort DataList '(lambda(x y)(< (car x)(car y)))))
      (xls DataList '("Номер позиции" "Количество") nil "Специф.")
      )
    )
  (princ "\nДанные уже в Excell'е")
  (princ)
  )
(princ "\nНаберите Нютка в командной строке")

VVA · 28.03.2007, 11:46

Нужные слои добавлять/убирать в этой строчке

Код:

[Выделить все]

 (setq laylist '("Технология" "Вода" "Электрика")) ;;<<Список слоев для выборки

Нютка · 28.03.2007, 14:08

ОГРОМНОЕ СПАСИБО!
Это именно то, что нужно!
Правда я ничего не понимаю, как это работает, но работает!

А можно я ещё понаглею?
У меня просто есть форматка спецификации......а можно ли сделать так, чтобы данные вставлялись именно в неё, причём позиция вставлялась в 1-ый столбец A, а количество в 7-ой столбец G и всё это начиная с 6-ой строки.
Заранее благодарю

Supermax · 28.03.2007, 15:39

Глянь вот сюда http://www.abok.ru/ibforum/index.php...0&#entry100286

VVA · 28.03.2007, 16:40

Нужна функции с VVA №12
Здесь тебе столбец A,G и 6 строка. Но новый лист.
Скопируй в этот лист шапочку форматки.

Код:

[Выделить все]

(defun C:Нютка2 ( / laylist pat ss DataList)
  (vl-load-com)
  (setq laylist '("Технология" "Вода" "Электрика")) ;;<<Список слоев для выборки
  (setq pat (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) laylist)))
  (if (setq ss (ssget "_X" (list '(0 . "TEXT")(cons 8 pat))))
    (progn
      (setq DataList (mapcar 'vla-get-textstring
                             (lib:selset-to-vlalist ss))
            DataList (mip_MakeUniqueMembersOfListWithCount DataList)
            )
      (setq DataList (mapcar '(lambda(x)(list (car x)(cdr x))) DataList))
      (setq DataList (vl-sort DataList '(lambda(x y)(< (atof (car x))(atof (car y))))))
      (setq DataList (mapcar '(lambda(x)(list (cadr x) ""  "" "" "" "" (cadr x))) DataList))
      (setq DataList (append (list '("")'("")'("")'("")) Datalist))
      (xls DataList '("Номер позиции" "" "" "" "" ""  "Количество") nil "Специф.")
      )
    )
  (princ "\nДанные уже в Excell'е")
  (princ)
  )
(princ "\nНаберите Нютка2 в командной строке")

Нютка · 29.03.2007, 09:59

Скопировала, сделала. Теперь итоги в новой книге, в 6-строке и нужных столбцах, но итог странный, одни цифры и то не те.

Нютка · 29.03.2007, 10:06

Возник ещё вопрос. Мне приходится загружать этот .lsp каждый раз, как загружаю AutoCad. А как сделать, чтобы это было автоматически

VVA · 29.03.2007, 11:38

Сорри, опечатоска вышла

Код:

[Выделить все]

(defun C:Нютка2 ( / laylist pat ss DataList)
  (vl-load-com)
  (setq laylist '("Технология" "Вода" "Электрика")) ;;<<Список слоев для выборки
  (setq pat (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) laylist)))
  (if (setq ss (ssget "_X" (list '(0 . "TEXT")(cons 8 pat))))
    (progn
      (setq DataList (mapcar 'vla-get-textstring
                             (lib:selset-to-vlalist ss))
            DataList (mip_MakeUniqueMembersOfListWithCount DataList)
            )
      (setq DataList (mapcar '(lambda(x)(list (car x)(cdr x))) DataList))
      (setq DataList (vl-sort DataList '(lambda(x y)(< (atof (car x))(atof (car y))))))
      (setq DataList (mapcar '(lambda(x)(list (car x) ""  "" "" "" "" (cadr x))) DataList))
      (setq DataList (append (list '("")'("")'("")'("")) Datalist))
      (xls DataList '("Номер позиции" "" "" "" "" ""  "Количество") nil "Специф.")
      )
    )
  (princ "\nДанные уже в Excell'е")
  (princ)
  )
(princ "\nНаберите Нютка2 в командной строке")

Цитата:

Возник ещё вопрос. Мне приходится загружать этот .lsp каждый раз, как загружаю AutoCad. А как сделать, чтобы это было автоматически

Ссылку я кому приводил выше?
Как использовать LISP, опубликованный на форуме

Нютка · 29.03.2007, 12:06

Примите извенения, естественно прочитала, но в конце уже не внимательно! Теперь всё хорошо!
Только вот, если не затруднит, можно ещё корректировочку.
В первом варианте сразу шла сортировку, хотелось бы и здесь. И ещё....хотелось бы чтобы это сразу вставлялось в файл D:\Аня\спецификация_объект лист называется Спецификация.
У меня там есть шапочка, поэтому слов позиция, количество - не надо. Только сам итог в нужные ячейки. Если это возможно, то век благодарна буду

Butenko · 29.03.2007, 13:11

бьютифолет процветает :idea:

VVA · 29.03.2007, 18:50

Получите.

Код:

[Выделить все]

;|============================================================================= 
*    Функция преобразования набора, полученного через (ssget), в список 
* ename-примитивов. 
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA. 
*    Параметры вызова: 
*   selset   набор примитивов 
*    Примеры вызова: 
(lib:selset-to-enamelist (ssget)) 
=============================================================================|; 
(defun lib:selset-to-enamelist (selset) 
(if selset (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))))) 

;|============================================================================= 
*    Функция преобразования набора, полученного через (ssget), в список 
* vla-примитивов. 
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA. 
*    Параметры вызова: 
*   selset   набор примитивов 
*    Примеры вызова: 
(lib:selset-to-vlalist (ssget)) 
=============================================================================|; 
(defun lib:selset-to-vlalist(selset) 
(if selset (mapcar 'vlax-ename->vla-object(lib:selset-to-enamelist selset)))) 

;| ===== mip_MakeUniqueMembersOfListWithCount ===== 
* Удаляет одинаковые (дубликаты) элементы из списка 
* с подсчетом числа вхождений элемента 
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA. 
* Пример вызова: 
(mip_MakeUniqueMembersOfListWithCount '( 1 2 3 1 2 3 1 1 2 2)) 
* Вернет ((1 . 4) (2 . 4) (3 . 2)) |; 
(defun mip_MakeUniqueMembersOfListWithCount  ( lst / OutList head count) 
  (while lst 
    (setq head (car lst) 
     count 0 
          lst (vl-remove-if '(lambda(pt)(if (equal pt head 1e-6)(setq count (1+ count)) nil)) lst) 
          OutList (append OutList (list (cons head count))))) 
  OutList 
  ) 
(defun mip-reg-get-path ()"HKEY_LOCAL_MACHINE\\Software\\MIP")
(defun mip-reg-write (key value ) ;;;Пишем в профиль в папку МИП
(vl-registry-write (mip-reg-get-path)
(VL-PRINC-TO-STRING key)(VL-PRINC-TO-STRING value)))
(defun mip-reg-read ( key )(vl-registry-read (mip-reg-get-path)
(VL-PRINC-TO-STRING key)))
(defun mip-conv-to-str (dat)
  (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
        ((null dat)(setq dat ""))
        (t (setq dat (vl-princ-to-string dat)))))
(defun mydcl (zagl info-list / fl ret dcl_id)
    (vl-load-com)
    (if (null zagl)
        (setq zagl "Выбор")
    ) ;_ end of if
    (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
    (setq ret (open fl "w"))
    (mapcar '(lambda (x) (write-line x ret))
      (list "mip_msg : dialog { "
         (strcat "label=\"" zagl "\";")
           " :list_box {"
           "alignment=top ;"
           "width=51 ;"
       (if (> (length info-list) 26) "height= 26 ;"
       (strcat "height= " (itoa (+ 3 (length info-list))) ";")) ;_ end of if
        "is_tab_stop = false ;"
        "key = \"info\";}"
        "ok_cancel;}")) ;_ end of mapcar
    (setq ret (close ret))
    (if (setq dcl_id (load_dialog fl))
        (if (new_dialog "mip_msg" dcl_id)
            (progn (start_list "info")(mapcar 'add_list info-list)
             (end_list)(set_tile "info" "0")
             (setq ret (car info-list))
       (action_tile "info" "(setq ret (nth (atoi $value) info-list))")
       (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))")
       (action_tile "accept" "(done_dialog 1)")
       (start_dialog)
            ) ;_ end of progn
        ) ;_ end of if
    ) ;_ end of if
    (unload_dialog dcl_id)(vl-file-delete fl)  ret)
;|================== XLSF ========================================
* Arguments:
              punto_datos - The list of lists of data (LIST) 
                            ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                            Each list of a kind (Value1 Value2... VlalueN) enters the name in
                            a separate line in corresponding columns (Value1-A Value2-B and .т.д.)
                  header -  The list (LIST) headings or nil a kind (" Signature A " " Signature B "...)
                            If header nil, is accepted ("X" "Y" "Z")
                 Colhide -  The list of alphabetic names of columns to hide or nil - to not hide ("A" "C" "D") - to hide columns A, C, D
                 Name_list - The name of a new leaf of the active book or nil - is not present
                 filename  - xls file or list (xlf_file Sheet_Name)
* Return: nil
* Usage
(xlsf '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Col1" "Col2" "Col3"  "Col4") '("B") "test" (getfiled "Excel Spreadsheet File" "" "XLS" 8))   |;
(defun xlsf ( punto_datos header Colhide Name_list filename / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols sheetname)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26) 
  TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
  Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
(if (listp filename)(setq sheetname (cadr filename) filename (car filename)))
(setq filename (vl-princ-to-string filename))
(if (/= (type sheetname) 'STR)(setq sheetname ""))(setq sheetname (strcase sheetname))
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
  (setq *Books-Colection* (vlax-get *AplExcel* "Workbooks"))
  (vlax-for bk *Books-Colection*
    (setq row (strcase(strcat (vlax-get-property bk 'Path) "\\"
                (vlax-get-property bk 'Name))))
    (if (= (strcase filename) row)
      (progn
      ;(vlax-invoke-method bk "Activate")  
      ;(setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
        (setq *New-Book*  bk))))
  (if (null *New-Book*)(setq *New-Book* (vla-open *Books-Colection* fileName)))
  (vla-put-visible  *AplExcel*  1)
  (setq *Sheet-Collection* (vlax-get-property *New-Book* "Sheets"))(setq cols nil)
(vlax-for sh *Sheet-Collection*
  (setq cols (cons (setq row(strcase(vlax-get-property sh 'Name))) cols))
  (if (= row sheetname)(setq *Sheet#1* sh))
  )
(if (null *Sheet#1*)
  (progn
    (setq *Sheet#1* (vlax-invoke-method *Sheet-Collection* "Add"))
    (setq Name_list (if (= Name_list "")
                  (vl-filename-base(getvar "DWGNAME"))
                  (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
   col 0)
    (setq row Name_list)
    (while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
    (setq Name_list row)
    (vlax-put-property *Sheet#1* 'Name Name_list)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))  
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_не использовать системные установки
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            ;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          ;_разделитель тысячей
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(if (/= (setq sheetname (vl-princ-to-string (nth (1- col) header))) "")
  (vlax-put-property *excell-cells* "Item" row col sheetname))
  (setq col (1+ col)))(setq  row 2 col 1)
(repeat (length punto_datos)(setq iz_listo (car punto_datos))
  (repeat (length iz_listo)(if (/= (setq sheetname (vl-princ-to-string (car iz_listo))) "")
      (vlax-put-property *excell-cells* "Item" row col sheetname))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq punto_datos (cdr punto_datos))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
	  (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))  
;(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))  
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
	  (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))    
(vlax-put-property cols 'hidden 1)  
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(setq sheetname (vlax-get-property *Sheet#1* 'Name))  
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc) sheetname)

(defun XL-get-SheetName->List (fileName / SheetList *Sheet-Collection* *New-Book* *Books-Colection* *AplExcel*)
  (if (vl-file-systime (vl-princ-to-string fileName))
    (progn
      (setq  *AplExcel*     (vlax-create-object "Excel.Application"))
      (vla-put-visible  *AplExcel*  0)
      (setq *Books-Colection* (vlax-get *AplExcel* "Workbooks"))
      (setq *New-Book* (vla-open *Books-Colection* fileName))
      (setq *Sheet-Collection* (vlax-get-property *New-Book* "Sheets"))
      (vlax-for sh *Sheet-Collection* (setq SheetList (cons (strcase(vlax-get-property sh 'Name)) SheetList)))
      (vlax-invoke-method *AplExcel* 'QUIT)
(mapcar 'vlax-release-object
        (list *Sheet-Collection* *New-Book* *Books-Colection* *AplExcel*))
      )
    (alert (strcat "Невозможно открыть\n" filename "\nУже открыт или отсутствует"))
    )
SheetList
  )

(defun XL-get-isOpenFile ( fileName / path *Books-Colection* *AplExcel* ret)

  (if (setq  *AplExcel*     (vlax-get-object "Excel.Application"))
    (progn
      (setq *Books-Colection* (vlax-get *AplExcel* "Workbooks"))
      (vlax-for bk *Books-Colection* (setq path (strcase
        (strcat (vlax-get-property bk 'Path) "\\"
        (vlax-get-property bk 'Name))))
        (if (= (strcase filename) path)(setq ret path)))
      (mapcar 'vlax-release-object
        (list *Books-Colection* *AplExcel*))
      )
    )
  ret
  )
    
(defun C:XLFileRmb ( / fileName SheetList Sheet)
(setq fileName (getfiled "Excel Spreadsheet File" (if oldFileName oldFileName "") "XLS" 8))
(if (setq SheetList (XL-get-SheetName->List  fileName))
  (progn
  (if (setq Sheet (mydcl "Выберите лист" (vl-sort SheetList '<)))
    (progn
      (mip-reg-write "LASTXLSDIR" (vl-filename-directory fileName))
      (mip-reg-write "LASTXLSFILE" (strcat (vl-filename-base fileName)(vl-filename-extension fileName)))
      (mip-reg-write "LASTXLSSHEET" Sheet)
      (princ "\nДанные запомнены")
      (princ "\nФайл -")(princ filename)
      (princ "\nЛист -")(princ Sheet)
      )
    )
  )
  )
  (princ)
  )

  (defun C:SP2XL ( / laylist pat ss DataList filename sheet)
  (vl-load-com)
  (setq laylist '("Технология" "Вода" "Электрика")) ;;<<Список слоев для выборки
  (setq pat (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) laylist)))
(setq filename (strcat (mip-conv-to-str(mip-reg-read "LASTXLSDIR")) "\\"
    (mip-conv-to-str(mip-reg-read "LASTXLSFILE"))))
(setq sheet (mip-conv-to-str(mip-reg-read "LASTXLSSHEET")))
(if (or
      (and (findfile fileName)(XL-get-isOpenFile fileName))
      (vl-file-systime (vl-princ-to-string fileName)))
  (progn
  (if (setq ss (ssget "_X" (list '(0 . "TEXT")(cons 8 pat))))
    (progn
      (setq DataList (mapcar 'vla-get-textstring
                             (lib:selset-to-vlalist ss))
            DataList (mip_MakeUniqueMembersOfListWithCount DataList)
            )
      (setq DataList (mapcar '(lambda(x)(list (car x)(cdr x))) DataList))
      (setq DataList (vl-sort DataList '(lambda(x y)(< (car x)(car y)))))
      (setq DataList (mapcar '(lambda(x)(list (car x) ""  "" "" "" "" (cadr x))) DataList))
      (setq DataList (append (list '("")'("")'("")'("")) Datalist))
      (setq sheet (xlsf DataList '("" "" "" "" "" ""  "") nil nil (list filename sheet)))
      (princ "\nДанные уже в Excell'е в листе ")(princ sheet)
      )
    )
  )
  (alert
   (strcat "Невозможно открыть\n" filename
           "\nУже открыт, отсутствует или не задан\nВыполните команду XLFileRmb"))
  )
  (princ)
  )
(princ "\nКоманды SP2XL и XLFileRmb загружены")

Две команды
XLFileRmb - запоминает файл Экселя и лист для вывода.
Достаточно выполнить 1 раз. Запоминается в реестре.
SP2XL - бывшая НЮТКА2

Нютка · 30.03.2007, 10:43

ОГРОМНОЕ ЧЕЛОВЕЧЕСКОЕ СПАСИБО!!!!!!!!!!!!!!!!!!!!!!
Всё работает как надо, просто прелесть. Сама бы, естественно не додумалась, видимо придётся покупать какую-нибудь умную книжку и идти на какие-нибудь курсы.

Но раз уж на то пошло, может помежете с последней проблемкой

Та програмка была для стадии Р. Но есть ещё стадия П. Там мы не расставляем оборудование, а рисуем так называемые выноски, типа 10-1
15-2
25-6
А-1-5
и т.д., где 10-позиция оборудования, а 1 - количество.

Все это написано однострочным текстом. Та програмка тоже прекрасно всё считае, но вот в чём загвоздка.....
В итоге получается:
10-1 5
15-2 10
25-6 20
А-1-5 1

А можно как нибудь сделать, чтобы сдесь уже пошло разделение на 3 столбца:
10 1 5
15 2 10
25 6 20
А-1 5 1

Причё в примере с буквами, первая цифра после тире остаётся вместе с буквой, а вторая отсекается.
Соответственно, потом нужно будет просто умножить 1х5, 2х10, 6х20, 5х1. И всё
Если это возможно, я буду просто счастлива.
Заранее спасибо!

VVA · 30.03.2007, 15:06

Кое-что поменял, поэтому опять весь код

Код:

[Выделить все]

;|============================================================================= 
*    Функция преобразования набора, полученного через (ssget), в список 
* ename-примитивов. 
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA. 
*    Параметры вызова: 
*   selset   набор примитивов 
*    Примеры вызова: 
(lib:selset-to-enamelist (ssget)) 
=============================================================================|; 
(defun lib:selset-to-enamelist (selset) 
(if selset (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))))) 

;|============================================================================= 
*    Функция преобразования набора, полученного через (ssget), в список 
* vla-примитивов. 
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA. 
*    Параметры вызова: 
*   selset   набор примитивов 
*    Примеры вызова: 
(lib:selset-to-vlalist (ssget)) 
=============================================================================|; 
(defun lib:selset-to-vlalist(selset) 
(if selset (mapcar 'vlax-ename->vla-object(lib:selset-to-enamelist selset)))) 

;| ===== mip_MakeUniqueMembersOfListWithCount ===== 
* Удаляет одинаковые (дубликаты) элементы из списка 
* с подсчетом числа вхождений элемента 
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA. 
* Пример вызова: 
(mip_MakeUniqueMembersOfListWithCount '( 1 2 3 1 2 3 1 1 2 2)) 
* Вернет ((1 . 4) (2 . 4) (3 . 2)) |; 
(defun mip_MakeUniqueMembersOfListWithCount  ( lst / OutList head count) 
  (while lst 
    (setq head (car lst) 
     count 0 
          lst (vl-remove-if '(lambda(pt)(if (equal pt head 1e-6)(setq count (1+ count)) nil)) lst) 
          OutList (append OutList (list (cons head count))))) 
  OutList 
  ) 
(defun mip-reg-get-path ()"HKEY_LOCAL_MACHINE\\Software\\MIP")
(defun mip-reg-write (key value ) ;;;Пишем в профиль в папку МИП
(vl-registry-write (mip-reg-get-path)
(VL-PRINC-TO-STRING key)(VL-PRINC-TO-STRING value)))
(defun mip-reg-read ( key )(vl-registry-read (mip-reg-get-path)
(VL-PRINC-TO-STRING key)))
(defun mip-conv-to-str (dat)
  (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
        ((null dat)(setq dat ""))
        (t (setq dat (vl-princ-to-string dat)))))
(defun mydcl (zagl info-list / fl ret dcl_id)
    (vl-load-com)
    (if (null zagl)
        (setq zagl "Выбор")
    ) ;_ end of if
    (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
    (setq ret (open fl "w"))
    (mapcar '(lambda (x) (write-line x ret))
      (list "mip_msg : dialog { "
         (strcat "label=\"" zagl "\";")
           " :list_box {"
           "alignment=top ;"
           "width=51 ;"
       (if (> (length info-list) 26) "height= 26 ;"
       (strcat "height= " (itoa (+ 3 (length info-list))) ";")) ;_ end of if
        "is_tab_stop = false ;"
        "key = \"info\";}"
        "ok_cancel;}")) ;_ end of mapcar
    (setq ret (close ret))
    (if (setq dcl_id (load_dialog fl))
        (if (new_dialog "mip_msg" dcl_id)
            (progn (start_list "info")(mapcar 'add_list info-list)
             (end_list)(set_tile "info" "0")
             (setq ret (car info-list))
       (action_tile "info" "(setq ret (nth (atoi $value) info-list))")
       (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))")
       (action_tile "accept" "(done_dialog 1)")
       (start_dialog)
            ) ;_ end of progn
        ) ;_ end of if
    ) ;_ end of if
    (unload_dialog dcl_id)(vl-file-delete fl)  ret)
;|================== XLSF ========================================
* Arguments:
              punto_datos - The list of lists of data (LIST) 
                            ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                            Each list of a kind (Value1 Value2... VlalueN) enters the name in
                            a separate line in corresponding columns (Value1-A Value2-B and .т.д.)
                  header -  The list (LIST) headings or nil a kind (" Signature A " " Signature B "...)
                            If header nil, is accepted ("X" "Y" "Z")
                 Colhide -  The list of alphabetic names of columns to hide or nil - to not hide ("A" "C" "D") - to hide columns A, C, D
                 Name_list - The name of a new leaf of the active book or nil - is not present
                 filename  - xls file or list (xlf_file Sheet_Name)
* Return: nil
* Usage
(xlsf '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Col1" "Col2" "Col3"  "Col4") '("B") "test" (getfiled "Excel Spreadsheet File" "" "XLS" 8))   |;
(defun xlsf ( punto_datos header Colhide Name_list filename / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols sheetname )
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26) 
  TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
  Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
(if (listp filename)(setq sheetname (cadr filename) filename (car filename)))
(setq filename (vl-princ-to-string filename))
(if (/= (type sheetname) 'STR)(setq sheetname ""))(setq sheetname (strcase sheetname))
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
  (setq *Books-Colection* (vlax-get *AplExcel* "Workbooks"))
  (setq filename (vl-princ-to-string filename))
  (vlax-for bk *Books-Colection*
    (setq row (strcase(strcat (vlax-get-property bk 'Path) "\\"
                (vlax-get-property bk 'Name))))
    (if (= (strcase filename) row)
      (progn
      ;(vlax-invoke-method bk "Activate")  
      ;(setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
        (setq *New-Book*  bk))))
  (if (null *New-Book*)
    (if (vl-file-systime fileName)
      (setq *New-Book* (vla-open *Books-Colection* fileName))
      (if (null (setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook")))
          (setq *New-Book* (vlax-invoke-method *Books-Colection* "Add")))
      )
    )
  (vla-put-visible  *AplExcel*  1)
  (setq *Sheet-Collection* (vlax-get-property *New-Book* "Sheets"))(setq cols nil)
(vlax-for sh *Sheet-Collection*
  (setq cols (cons (setq row(strcase(vlax-get-property sh 'Name))) cols))
  (if (= row sheetname)(setq *Sheet#1* sh))
  )
(if (null *Sheet#1*)
  (progn
    (setq *Sheet#1* (vlax-invoke-method *Sheet-Collection* "Add"))
    (setq Name_list (if (= Name_list "")
                  (vl-filename-base(getvar "DWGNAME"))
                  (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
   col 0)
    (setq row Name_list)
    (while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
    (setq Name_list row)
    (vlax-put-property *Sheet#1* 'Name Name_list)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))  
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_не использовать системные установки
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            ;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          ;_разделитель тысячей
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(if (/= (setq sheetname (vl-princ-to-string (nth (1- col) header))) "")
  (vlax-put-property *excell-cells* "Item" row col sheetname))
  (setq col (1+ col)))(setq  row 2 col 1)
(repeat (length punto_datos)(setq iz_listo (car punto_datos))
  (repeat (length iz_listo)(if (/= (setq sheetname (vl-princ-to-string (car iz_listo))) "")
      (vlax-put-property *excell-cells* "Item" row col sheetname))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq punto_datos (cdr punto_datos))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
	  (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))  
;(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))  
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
	  (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))    
(vlax-put-property cols 'hidden 1)  
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(setq sheetname (vlax-get-property *Sheet#1* 'Name))  
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc) sheetname)

(defun XL-get-SheetName->List (fileName / SheetList *Sheet-Collection* *New-Book* *Books-Colection* *AplExcel*)
  (if (vl-file-systime (vl-princ-to-string fileName))
    (progn
      (setq  *AplExcel*     (vlax-create-object "Excel.Application"))
      (vla-put-visible  *AplExcel*  0)
      (setq *Books-Colection* (vlax-get *AplExcel* "Workbooks"))
      (setq *New-Book* (vla-open *Books-Colection* fileName))
      (setq *Sheet-Collection* (vlax-get-property *New-Book* "Sheets"))
      (vlax-for sh *Sheet-Collection* (setq SheetList (cons (strcase(vlax-get-property sh 'Name)) SheetList)))
      (vlax-invoke-method *AplExcel* 'QUIT)
(mapcar 'vlax-release-object
        (list *Sheet-Collection* *New-Book* *Books-Colection* *AplExcel*))
      )
    (alert (strcat "Невозможно открыть\n" filename "\nУже открыт или отсутствует"))
    )
SheetList
  )

(defun XL-get-isOpenFile ( fileName / path *Books-Colection* *AplExcel* ret)

  (if (setq  *AplExcel*     (vlax-get-object "Excel.Application"))
    (progn
      (setq *Books-Colection* (vlax-get *AplExcel* "Workbooks"))
      (vlax-for bk *Books-Colection* (setq path (strcase
        (strcat (vlax-get-property bk 'Path) "\\"
        (vlax-get-property bk 'Name))))
        (if (= (strcase filename) path)(setq ret path)))
      (mapcar 'vlax-release-object
        (list *Books-Colection* *AplExcel*))
      )
    )
  ret
  )
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
)

(defun C:XLFileRmb ( / fileName SheetList Sheet)
(setq fileName (getfiled "Excel Spreadsheet File" (if oldFileName oldFileName "") "XLS" 8))
(if (setq SheetList (XL-get-SheetName->List  fileName))
  (progn
  (if (setq Sheet (mydcl "Выберите лист" (vl-sort SheetList '<)))
    (progn
      (mip-reg-write "LASTXLSDIR" (vl-filename-directory fileName))
      (mip-reg-write "LASTXLSFILE" (strcat (vl-filename-base fileName)(vl-filename-extension fileName)))
      (mip-reg-write "LASTXLSSHEET" Sheet)
      (princ "\nДанные запомнены")
      (princ "\nФайл -")(princ filename)
      (princ "\nЛист -")(princ Sheet)
      )
    )
  )
  )
  (princ)
  )

  (defun C:SP2XL ( / laylist pat ss DataList filename sheet)
  (vl-load-com)
  (setq laylist '("Технология" "Вода" "Электрика")) ;;<<Список слоев для выборки
  (setq pat (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) laylist)))
(setq filename (strcat (mip-conv-to-str(mip-reg-read "LASTXLSDIR")) "\\"
    (mip-conv-to-str(mip-reg-read "LASTXLSFILE"))))
(setq sheet (mip-conv-to-str(mip-reg-read "LASTXLSSHEET")))
(if (or
      (and (findfile fileName)(XL-get-isOpenFile fileName))
      (vl-file-systime (vl-princ-to-string fileName)))
  (progn
  (if (setq ss (ssget "_X" (list '(0 . "TEXT")(cons 8 pat))))
    (progn
      (setq DataList (mapcar 'vla-get-textstring
                             (lib:selset-to-vlalist ss))
            DataList (mip_MakeUniqueMembersOfListWithCount DataList)
            )
      (setq DataList (mapcar '(lambda(x)(list (car x)(cdr x))) DataList))
      (setq DataList (vl-sort DataList '(lambda(x y)(< (car x)(car y)))))
      (setq DataList (mapcar '(lambda(x)(list (car x) ""  "" "" "" "" (cadr x))) DataList))
      (setq DataList (append (list '("")'("")'("")'("")) Datalist))
      (setq sheet (xlsf DataList '("" "" "" "" "" ""  "") nil nil (list filename sheet)))
      (princ "\nДанные уже в Excell'е в листе ")(princ sheet)
      )
    )
  )
  (alert
   (strcat "Невозможно открыть\n" filename
           "\nУже открыт, отсутствует или не задан\nВыполните команду XLFileRmb"))
  )
  (princ)
  )
(defun C:SP2XL-P ( / laylist pat ss DataList filename sheet)
  (vl-load-com)
  (setq laylist '("Технология" "Вода" "Электрика")) ;;<<Список слоев для выборки
  (setq pat (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) laylist)))
(setq filename (strcat (mip-conv-to-str(mip-reg-read "LASTXLSDIR")) "\\"
    (mip-conv-to-str(mip-reg-read "LASTXLSFILE"))))
(setq sheet (mip-conv-to-str(mip-reg-read "LASTXLSSHEET")))
(if (or
      (and (findfile fileName)(XL-get-isOpenFile fileName))
      (vl-file-systime (vl-princ-to-string fileName)))
  (progn
  (if (setq ss (ssget "_X" (list '(0 . "TEXT")(cons 8 pat))))
    (progn
      (setq DataList (mapcar 'vla-get-textstring
                             (lib:selset-to-vlalist ss))
            DataList (mip_MakeUniqueMembersOfListWithCount DataList)
            )
      (setq DataList (mapcar '(lambda(x)(list (car x)(cdr x))) DataList))
      (setq DataList (mapcar '(lambda( lst / hd tl sp)
                                (setq hd (strcat "'" (car lst)) tl (cadr lst))
                                (setq sp (str-str-lst hd "-"))
                                (cond ((= (length sp) 1)
                                       (list hd 1 tl))
                                      ((= (length sp) 2)
                                       (list (car sp)(atoi (cadr sp)) tl))
                                      (t (list
                                           (vl-string-right-trim "-"
                                             (apply 'strcat
                                                    (mapcar
                                                      '(lambda(x)(strcat x "-"))
                                                      (reverse(cdr(reverse sp))))))
                                           (atoi (last sp)) tl))
                                      )
                                )
                             DataList)
            )
;_== Уплотняем >      
      (setq pat nil)
      (mapcar '(lambda(x / hd)
                 (if (setq hd (assoc (car x) pat))
                   (setq pat (subst (append (list(car x))
                                  (mapcar '+ (cdr hd)(cdr x)))
                          hd pat))
                   (setq pat (append pat (list x))))
                 )
              DataList)
      (setq DataList pat)
;_== Уплотняем <              
      (setq DataList (vl-sort DataList '(lambda(x y)(< (car x)(car y)))))
;      (setq DataList (mapcar '(lambda(x)(list (car x) ""  "" "" "" "" (cadr x))) DataList))
;      (setq DataList (append (list '("")'("")'("")'("")) Datalist))
      (setq pat 1)
      (setq Datalist (mapcar '(lambda (x)
                (setq pat (1+ pat))
                (append x (list (strcat "=B" (itoa pat) "*C" (itoa pat)))))
              DataList))
      (setq sheet (xlsf DataList '("Поз" "Кол1" "Кол2" "Кол1*Кол2") nil "Стадия P" filename))
      (princ "\nДанные уже в Excell'е в листе ")(princ sheet)
      )
    )
  )
  (alert
   (strcat "Невозможно открыть\n" filename
           "\nУже открыт, отсутствует или не задан\nВыполните команду XLFileRmb"))
  )
  (princ)
  )
(princ "\nКоманды SP2XL SP2XL-P и XLFileRmb загружены")

Соответственно новая команда SP2XL-P

Нютка · 30.03.2007, 15:27

Ух ты! Считает прекрасно, но итог выдаёт странный. То есть лист, который создаётся новый - там всё понятно, всё хорошо, а вот на нужный лист переносит всего несколько позиций и то со странным количеством

VVA · 30.03.2007, 15:57

А так

Код:

[Выделить все]

(defun C:SP2XL-P1 ( / laylist pat ss DataList filename sheet)
  (vl-load-com)
  (setq laylist '("Технология" "Вода" "Электрика")) ;;<<Список слоев для выборки
  (setq pat (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) laylist)))
(setq filename (strcat (mip-conv-to-str(mip-reg-read "LASTXLSDIR")) "\\"
    (mip-conv-to-str(mip-reg-read "LASTXLSFILE"))))
(setq sheet (mip-conv-to-str(mip-reg-read "LASTXLSSHEET")))
(if (or
      (and (findfile fileName)(XL-get-isOpenFile fileName))
      (vl-file-systime (vl-princ-to-string fileName)))
  (progn
  (if (setq ss (ssget "_X" (list '(0 . "TEXT")(cons 8 pat))))
    (progn
      (setq DataList (mapcar 'vla-get-textstring
                             (lib:selset-to-vlalist ss))
            DataList (mip_MakeUniqueMembersOfListWithCount DataList)
            )
      (setq DataList (mapcar '(lambda(x)(list (car x)(cdr x))) DataList))
      (setq DataList (mapcar '(lambda( lst / hd tl sp)
                                (setq hd (strcat "'" (car lst)) tl (cadr lst))
                                (setq sp (str-str-lst hd "-"))
                                (cond ((= (length sp) 1)
                                       (list hd 1 tl))
                                      ((= (length sp) 2)
                                       (list (car sp)(atoi (cadr sp)) tl))
                                      (t (list
                                           (vl-string-right-trim "-"
                                             (apply 'strcat
                                                    (mapcar
                                                      '(lambda(x)(strcat x "-"))
                                                      (reverse(cdr(reverse sp))))))
                                           (atoi (last sp)) tl))
                                      )
                                )
                             DataList)
            )
      (setq DataList (vl-sort DataList '(lambda(x y)(< (car x)(car y)))))
;      (setq DataList (mapcar '(lambda(x)(list (car x) ""  "" "" "" "" (cadr x))) DataList))
;      (setq DataList (append (list '("")'("")'("")'("")) Datalist))
      (setq pat 1)
      (setq Datalist (mapcar '(lambda (x)
                (setq pat (1+ pat))
                (append x (list (strcat "=B" (itoa pat) "*C" (itoa pat)))))
              DataList))
      (setq sheet (xlsf DataList '("Поз" "Кол1" "Кол2" "Кол1*Кол2") nil "Стадия P" filename))
      (princ "\nДанные уже в Excell'е в листе ")(princ sheet)
      )
    )
  )
  (alert
   (strcat "Невозможно открыть\n" filename
           "\nУже открыт, отсутствует или не задан\nВыполните команду XLFileRmb"))
  )
  (princ)
  )

В запуске лиспа, надеюсь, ты уже гуру. Разберешься что куда вставить

Нютка · 30.03.2007, 16:17

Всё равно не так вставляется, считает - хорошо, но потом, когда переходит, количество - нормально, но в 1-ом столбце с номером позиции остаётся две цифры, то есть
10-2 6,
а надо
10 6

VVA · 30.03.2007, 16:53

В четреже есть тексты
10-1 - 2 шт
10-2 - 1 шт
А-15-1 - 1 шт
Что нужно в Экселе в столбце A,B,C,D
PS. Так. На свякий случай в VVA №26 команда называется SP2XL-P1
Вот что у меня дыет с этими данными
[ATTACH]1175259219.jpg[/ATTACH]

GarryPop · 30.03.2007, 17:05

Доброго времени суток.
Хотелось бы задать вопрос. Попробовал лисп, но програмка почемуто не работает. Стал разбираться пошагово SheetList значение принимает nil. Ну а дальше все на замыкает на конец программы.

(if (setq SheetList (XL-get-SheetName->List fileName))
(progn
(if (setq Sheet (mydcl "Выберите лист" (vl-sort SheetList '<)))
(progn
(mip-reg-write "LASTXLSDIR" (vl-filename-directory fileName))
(mip-reg-write "LASTXLSFILE" (strcat (vl-filename-base fileName)(vl-filename-extension fileName)))
(mip-reg-write "LASTXLSSHEET" Sheet)
(princ "\nДанные запомнены")
(princ "\nФайл -")(princ filename)
(princ "\nЛист -")(princ Sheet)
)
)
)

)

VVA · 30.03.2007, 17:24

Вожможно, не загружен (vl-load-com)Попробуй так

Код:

[Выделить все]

(defun C:XLFileRmb ( / fileName SheetList Sheet)
(vl-load-com)  
(setq fileName (getfiled "Excel Spreadsheet File" (if oldFileName oldFileName "") "XLS" 8))
(if (setq SheetList (XL-get-SheetName->List  fileName))
  (progn
  (if (setq Sheet (mydcl "Выберите лист" (vl-sort SheetList '<)))
    (progn
      (mip-reg-write "LASTXLSDIR" (vl-filename-directory fileName))
      (mip-reg-write "LASTXLSFILE" (strcat (vl-filename-base fileName)(vl-filename-extension fileName)))
      (mip-reg-write "LASTXLSSHEET" Sheet)
      (princ "\nДанные запомнены")
      (princ "\nФайл -")(princ filename)
      (princ "\nЛист -")(princ Sheet)
      )
    )
  )
  )
  (princ)
  )

VVA · 30.03.2007, 17:28

А что вохзвращает эта строчка ?

Код:

[Выделить все]

(setq fileName (getfiled "Excel Spreadsheet File" (if oldFileName oldFileName "") "XLS" 8))

GarryPop · 30.03.2007, 17:37

Попробовал не выходит. Не выполняется условие

defun XL-get-SheetName->List (fileName / SheetList *Sheet-Collection* *New-Book* *Books-Colection* *AplExcel*)
(if (vl-file-systime (vl-princ-to-string fileName))

GarryPop · 30.03.2007, 17:41

При запросе показываю екселевский файл.
а fileName принимает значение "111.xls"

GarryPop · 30.03.2007, 18:09

Перенес файл 111.xls с рабочего стола на диск C вроде XLFileRmb запустился и весь прошел. Но SP2XL-P1 проходит опять не весь где-то не выполняется условие

VVA · 30.03.2007, 18:13

Код:

[Выделить все]

(setq fileName (getfiled "Excel Spreadsheet File" (if oldFileName oldFileName "") "XLS" 8))

В переменной fileName должен быть полный путь к файлу, типа
"C:\\TEST\\test.xls"
Скопируй файл в другое место и попробуй снова

VVA · 30.03.2007, 19:46

Она подсчитывает тексты на слоях "Технология" "Вода" "Электрика"
см. строчку

Код:

[Выделить все]

(setq laylist '("Технология" "Вода" "Электрика")) ;;<<Список слоев для выборки

GarryPop · 31.03.2007, 12:21

Доброго времени суток.
Программа доходит до этого условия ss принимает значение nil
if (setq ss (ssget "_X" (list '(0 . "TEXT")(cons 8 pat)))

Кулик Алексей aka kpblc · 31.03.2007, 16:32

А чему на этот момент равно pat? Может, на этом слое нет текстов?

Нютка · 02.04.2007, 09:45

[quote="VVA"]В четреже есть тексты
10-1 - 2 шт
10-2 - 1 шт
А-15-1 - 1 шт
Что нужно в Экселе в столбце A,B,C,D
PS. Так. На свякий случай в VVA №26 команда называется SP2XL-P1

В общем у меня есть спецификация: прикрепила.
Во 2, 3, 5, 6 и 8 столбцах - у меня ссылки на мою базу оборудования.
И при вставке номера позиции отоброжаются все данные.
Поэтому мне надо, чтобы из Autocada номер позиции вставлялся в 1-ый столбец, а кол-во - в 7.
[ATTACH]1175492853.rar[/ATTACH]

VVA · 02.04.2007, 10:34

Давай по порядку
VVA №24 + VVA № 26 - код.
По поводу спецификации в 1-й и 7-й слолбец SP2XL выводит.
По поводу Нютка №23, 27 и VVA №28. Две команды
SP2XL-P и SP2XL-P1. Что не устраивает в них? Мне пока не понятно как нужно считать на стадии P. Вопрос в VVA № 28

Нютка · 02.04.2007, 11:22

Значит так:
на стадии П мы оборудование мы не расставляем, а рисуем выноски:
см. файл.
Так вот. При загрузке команды sp2xl-p1, данные передаются на новый лист в книгу Спецификация_объект, но потом нужно, чтобы оттуда номер и количество перешли на лист Спецификация.
[ATTACH]1175498578.rar[/ATTACH]

P.S. название слоя я поменяла

VVA · 02.04.2007, 12:01

Выполни команду sp2xl-p1 и скажи, какике стдобцы Excell'a тебе нужно в спецификацию. A,B,C,D ? В столбцах B,C,D количество. Какое нужно-то?
И еще. В твоем примере текст на слое "Выноски", раньше речь шла про слои "Технология" "Вода" "Электрика".

Нютка · 02.04.2007, 12:05

Технология, Электрика и Вода - это для стадии Рабочка, а в стадии Проект - используемый слой- Выноски, в програмке я поменяла.

А в спецификацию мне надо столбец А (позиция) и столбец D (кол-во)

VVA · 02.04.2007, 13:12

Были сделани незначительные изменения. Привожу весь лисп

Код:

[Выделить все]

;|============================================================================= 
*    Функция преобразования набора, полученного через (ssget), в список 
* ename-примитивов. 
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA. 
*    Параметры вызова: 
*   selset   набор примитивов 
*    Примеры вызова: 
(lib:selset-to-enamelist (ssget)) 
=============================================================================|; 
(defun lib:selset-to-enamelist (selset) 
(if selset (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))))) 

;|============================================================================= 
*    Функция преобразования набора, полученного через (ssget), в список 
* vla-примитивов. 
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA. 
*    Параметры вызова: 
*   selset   набор примитивов 
*    Примеры вызова: 
(lib:selset-to-vlalist (ssget)) 
=============================================================================|; 
(defun lib:selset-to-vlalist(selset) 
(if selset (mapcar 'vlax-ename->vla-object(lib:selset-to-enamelist selset)))) 

;| ===== mip_MakeUniqueMembersOfListWithCount ===== 
* Удаляет одинаковые (дубликаты) элементы из списка 
* с подсчетом числа вхождений элемента 
* Библиотечная функция МинскИнжПроект (С) Владимир Азарко aka VVA. 
* Пример вызова: 
(mip_MakeUniqueMembersOfListWithCount '( 1 2 3 1 2 3 1 1 2 2)) 
* Вернет ((1 . 4) (2 . 4) (3 . 2)) |; 
(defun mip_MakeUniqueMembersOfListWithCount  ( lst / OutList head count) 
  (while lst 
    (setq head (car lst) 
     count 0 
          lst (vl-remove-if '(lambda(pt)(if (equal pt head 1e-6)(setq count (1+ count)) nil)) lst) 
          OutList (append OutList (list (cons head count))))) 
  OutList 
  ) 
(defun mip-reg-get-path ()"HKEY_LOCAL_MACHINE\\Software\\MIP")
(defun mip-reg-write (key value ) ;;;Пишем в профиль в папку МИП
(vl-registry-write (mip-reg-get-path)
(VL-PRINC-TO-STRING key)(VL-PRINC-TO-STRING value)))
(defun mip-reg-read ( key )(vl-registry-read (mip-reg-get-path)
(VL-PRINC-TO-STRING key)))
(defun mip-conv-to-str (dat)
  (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
        ((null dat)(setq dat ""))
        (t (setq dat (vl-princ-to-string dat)))))
(defun mydcl (zagl info-list / fl ret dcl_id)
    (vl-load-com)
    (if (null zagl)
        (setq zagl "Выбор")
    ) ;_ end of if
    (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
    (setq ret (open fl "w"))
    (mapcar '(lambda (x) (write-line x ret))
      (list "mip_msg : dialog { "
         (strcat "label=\"" zagl "\";")
           " :list_box {"
           "alignment=top ;"
           "width=51 ;"
       (if (> (length info-list) 26) "height= 26 ;"
       (strcat "height= " (itoa (+ 3 (length info-list))) ";")) ;_ end of if
        "is_tab_stop = false ;"
        "key = \"info\";}"
        "ok_cancel;}")) ;_ end of mapcar
    (setq ret (close ret))
    (if (setq dcl_id (load_dialog fl))
        (if (new_dialog "mip_msg" dcl_id)
            (progn (start_list "info")(mapcar 'add_list info-list)
             (end_list)(set_tile "info" "0")
             (setq ret (car info-list))
       (action_tile "info" "(setq ret (nth (atoi $value) info-list))")
       (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))")
       (action_tile "accept" "(done_dialog 1)")
       (start_dialog)
            ) ;_ end of progn
        ) ;_ end of if
    ) ;_ end of if
    (unload_dialog dcl_id)(vl-file-delete fl)  ret)
;|================== XLSF ========================================
* Arguments:
              punto_datos - The list of lists of data (LIST) 
                            ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                            Each list of a kind (Value1 Value2... VlalueN) enters the name in
                            a separate line in corresponding columns (Value1-A Value2-B and .т.д.)
                  header -  The list (LIST) headings or nil a kind (" Signature A " " Signature B "...)
                            If header nil, is accepted ("X" "Y" "Z")
                 Colhide -  The list of alphabetic names of columns to hide or nil - to not hide ("A" "C" "D") - to hide columns A, C, D
                 Name_list - The name of a new leaf of the active book or nil - is not present
                 filename  - xls file or list (xlf_file Sheet_Name)
* Return: nil
* Usage
(xlsf '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Col1" "Col2" "Col3"  "Col4") '("B") "test" (getfiled "Excel Spreadsheet File" "" "XLS" 8))   |;
(defun xlsf ( punto_datos header Colhide Name_list filename / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols sheetname )
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26) 
  TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
  Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
(if (listp filename)(setq sheetname (cadr filename) filename (car filename)))
(setq filename (vl-princ-to-string filename))
(if (/= (type sheetname) 'STR)(setq sheetname ""))(setq sheetname (strcase sheetname))
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
  (setq *Books-Colection* (vlax-get *AplExcel* "Workbooks"))
  (setq filename (vl-princ-to-string filename))
  (vlax-for bk *Books-Colection*
    (setq row (strcase(strcat (vlax-get-property bk 'Path) "\\"
                (vlax-get-property bk 'Name))))
    (if (= (strcase filename) row)
      (progn
      ;(vlax-invoke-method bk "Activate")  
      ;(setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
        (setq *New-Book*  bk))))
  (if (null *New-Book*)
    (if (vl-file-systime fileName)
      (setq *New-Book* (vla-open *Books-Colection* fileName))
      (if (null (setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook")))
          (setq *New-Book* (vlax-invoke-method *Books-Colection* "Add")))
      )
    )
  (vla-put-visible  *AplExcel*  1)
  (setq *Sheet-Collection* (vlax-get-property *New-Book* "Sheets"))(setq cols nil)
(vlax-for sh *Sheet-Collection*
  (setq cols (cons (setq row(strcase(vlax-get-property sh 'Name))) cols))
  (if (= row sheetname)(setq *Sheet#1* sh))
  )
(if (null *Sheet#1*)
  (progn
    (setq *Sheet#1* (vlax-invoke-method *Sheet-Collection* "Add"))
    (setq Name_list (if (= Name_list "")
                  (vl-filename-base(getvar "DWGNAME"))
                  (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
   col 0)
    (setq row Name_list)
    (while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
    (setq Name_list row)
    (vlax-put-property *Sheet#1* 'Name Name_list)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))  
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_не использовать системные установки
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            ;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          ;_разделитель тысячей
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(if (/= (setq sheetname (vl-princ-to-string (nth (1- col) header))) "")
  (vlax-put-property *excell-cells* "Item" row col sheetname))
  (setq col (1+ col)))(setq  row 2 col 1)
(repeat (length punto_datos)(setq iz_listo (car punto_datos))
  (repeat (length iz_listo)(if (/= (setq sheetname (vl-princ-to-string (car iz_listo))) "")
      (vlax-put-property *excell-cells* "Item" row col sheetname))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq punto_datos (cdr punto_datos))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
	  (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))  
;(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))  
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
	  (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))    
(vlax-put-property cols 'hidden 1)  
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(setq sheetname (vlax-get-property *Sheet#1* 'Name))  
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc) sheetname)

(defun XL-get-SheetName->List (fileName / SheetList *Sheet-Collection* *New-Book* *Books-Colection* *AplExcel*)
  (if (vl-file-systime (vl-princ-to-string fileName))
    (progn
      (setq  *AplExcel*     (vlax-create-object "Excel.Application"))
      (vla-put-visible  *AplExcel*  0)
      (setq *Books-Colection* (vlax-get *AplExcel* "Workbooks"))
      (setq *New-Book* (vla-open *Books-Colection* fileName))
      (setq *Sheet-Collection* (vlax-get-property *New-Book* "Sheets"))
      (vlax-for sh *Sheet-Collection* (setq SheetList (cons (strcase(vlax-get-property sh 'Name)) SheetList)))
      (vlax-invoke-method *AplExcel* 'QUIT)
(mapcar 'vlax-release-object
        (list *Sheet-Collection* *New-Book* *Books-Colection* *AplExcel*))
      )
    (alert (strcat "Невозможно открыть\n" filename "\nУже открыт или отсутствует"))
    )
SheetList
  )

(defun XL-get-isOpenFile ( fileName / path *Books-Colection* *AplExcel* ret)

  (if (setq  *AplExcel*     (vlax-get-object "Excel.Application"))
    (progn
      (setq *Books-Colection* (vlax-get *AplExcel* "Workbooks"))
      (vlax-for bk *Books-Colection* (setq path (strcase
        (strcat (vlax-get-property bk 'Path) "\\"
        (vlax-get-property bk 'Name))))
        (princ "\n")(princ path)
        (if (= (strcase filename) path)(setq ret path)))
      (mapcar 'vlax-release-object
        (list *Books-Colection* *AplExcel*))
      )
    )
  ret
  )
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
)

(defun C:XLFileRmb ( / fileName SheetList Sheet)
(vl-load-com)  
(if(and (setq fileName (getfiled "Excel Spreadsheet File" (if oldFileName oldFileName "") "XLS" 16))
        (setq SheetList (XL-get-SheetName->List  fileName)))
  (progn
  (if (setq Sheet (mydcl "Выберите лист" (vl-sort SheetList '<)))
    (progn
      (mip-reg-write "LASTXLSDIR" (vl-filename-directory fileName))
      (mip-reg-write "LASTXLSFILE" (strcat (vl-filename-base fileName)(vl-filename-extension fileName)))
      (mip-reg-write "LASTXLSSHEET" Sheet)
      (princ "\nДанные запомнены")
      (princ "\nФайл -")(princ filename)
      (princ "\nЛист -")(princ Sheet)
      )
    )
  )
  )
  (princ)
  )

  (defun C:SP2XL ( / laylist pat ss DataList filename sheet)
  (vl-load-com)
  (setq laylist '("Технология" "Вода" "Электрика")) ;;<<Список слоев для выборки
  (setq pat (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) laylist)))
(setq filename (strcat (mip-conv-to-str(mip-reg-read "LASTXLSDIR"))
                       (mip-conv-to-str(mip-reg-read "LASTXLSFILE"))))
(setq sheet (mip-conv-to-str(mip-reg-read "LASTXLSSHEET")))
(if (or
      (and (findfile fileName)(XL-get-isOpenFile fileName))
      (vl-file-systime (vl-princ-to-string fileName)))
  (progn
  (if (setq ss (ssget "_X" (list '(0 . "TEXT")(cons 8 pat))))
    (progn
      (setq DataList (mapcar 'vla-get-textstring
                             (lib:selset-to-vlalist ss))
            DataList (mip_MakeUniqueMembersOfListWithCount DataList)
            )
      (setq DataList (mapcar '(lambda(x)(list (car x)(cdr x))) DataList))
      (setq DataList (vl-sort DataList '(lambda(x y)(< (car x)(car y)))))
      (setq DataList (mapcar '(lambda(x)(list (car x) ""  "" "" "" "" (cadr x))) DataList))
      (setq DataList (append (list '("")'("")'("")'("")) Datalist))
      (setq sheet (xlsf DataList '("" "" "" "" "" ""  "") nil nil (list filename sheet)))
      (princ "\nДанные уже в Excell'е в листе ")(princ sheet)
      )
    )
  )
  (alert
   (strcat "Невозможно открыть\n" filename
           "\nУже открыт, отсутствует или не задан\nВыполните команду XLFileRmb"))
  )
  (princ)
  )
(defun C:SP2XL-P1 ( / laylist pat ss DataList filename sheet)
  (vl-load-com)
  (setq laylist '("Выноски")) ;;<<Список слоев для выборки
  (setq pat (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) laylist)))
(setq filename (strcat (mip-conv-to-str(mip-reg-read "LASTXLSDIR")) "\\"
    (mip-conv-to-str(mip-reg-read "LASTXLSFILE"))))
(setq sheet (mip-conv-to-str(mip-reg-read "LASTXLSSHEET")))
(if (or
      (and (findfile fileName)(XL-get-isOpenFile fileName))
      (vl-file-systime (vl-princ-to-string fileName)))
  (progn
  (if (setq ss (ssget "_X" (list '(0 . "TEXT")(cons 8 pat))))
    (progn
      (setq DataList (mapcar 'vla-get-textstring
                             (lib:selset-to-vlalist ss))
            DataList (mip_MakeUniqueMembersOfListWithCount DataList)
            )
      (setq DataList (mapcar '(lambda(x)(list (car x)(cdr x))) DataList))
      (setq DataList (mapcar '(lambda( lst / hd tl sp)
                                (setq hd (strcat "'" (car lst)) tl (cadr lst))
                                (setq sp (str-str-lst hd "-"))
                                (cond ((= (length sp) 1)
                                       (list hd 1 tl))
                                      ((= (length sp) 2)
                                       (list (car sp)(atoi (cadr sp)) tl))
                                      (t (list
                                           (vl-string-right-trim "-"
                                             (apply 'strcat
                                                    (mapcar
                                                      '(lambda(x)(strcat x "-"))
                                                      (reverse(cdr(reverse sp))))))
                                           (atoi (last sp)) tl))
                                      )
                                )
                             DataList)
            )
      (setq DataList (vl-sort DataList '(lambda(x y)(< (car x)(car y)))))
      (setq Datalist (mapcar '(lambda (x)
                (append x (list (* (cadr x)(caddr x)))))
              DataList))
      (setq sheet (xlsf DataList '("Поз" "Кол1" "Кол2" "Кол1*Кол2") nil "Стадия P" filename))
      (princ "\nДанные уже в Excell'е в листе ")(princ sheet)
      (setq DataList (mapcar '(lambda(x)(list (vl-string-trim "'" (car x))(last x))) DataList))
      (setq DataList (mapcar '(lambda(x)(list (car x) ""  "" "" "" "" (cadr x))) DataList))
      (setq DataList (append (list '("")'("")'("")'("")) Datalist))
      (setq sheet (mip-conv-to-str(mip-reg-read "LASTXLSSHEET")))
      (setq sheet (xlsf DataList '("" "" "" "" "" ""  "") nil nil (list filename sheet)))
      (princ "\nДанные уже в Excell'е в листе ")(princ sheet)
      
      )
    )
  )
  (alert
   (strcat "Невозможно открыть\n" filename
           "\nУже открыт, отсутствует или не задан\nВыполните команду XLFileRmb"))
  )
  (princ)
  )
(princ "\nКоманды SP2XL SP2XL-P1 и XLFileRmb загружены")

Нютка · 02.04.2007, 13:53

Теперь всё переносит, НО
как бы так сделать, чтобы одинаковые позиции складывались ещё и по вертикали, то есть:
[ATTACH]1175507588.rar[/ATTACH]

VVA · 02.04.2007, 14:40

Замени SP2XL-P1 этой

Код:

[Выделить все]

(defun C:SP2XL-P1 ( / laylist pat ss DataList filename sheet)
  (vl-load-com)
  (setq laylist '("Выноски")) ;;<<Список слоев для выборки
  (setq pat (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) laylist)))
(setq filename (strcat (mip-conv-to-str(mip-reg-read "LASTXLSDIR")) "\\"
    (mip-conv-to-str(mip-reg-read "LASTXLSFILE"))))
(setq sheet (mip-conv-to-str(mip-reg-read "LASTXLSSHEET")))
(if (or
      (and (findfile fileName)(XL-get-isOpenFile fileName))
      (vl-file-systime (vl-princ-to-string fileName)))
  (progn
  (if (setq ss (ssget "_X" (list '(0 . "TEXT")(cons 8 pat))))
    (progn
      (setq DataList (mapcar 'vla-get-textstring
                             (lib:selset-to-vlalist ss))
            DataList (mip_MakeUniqueMembersOfListWithCount DataList)
            )
      (setq DataList (mapcar '(lambda(x)(list (car x)(cdr x))) DataList))
      (setq DataList (mapcar '(lambda( lst / hd tl sp)
                                (setq hd (strcat "'" (car lst)) tl (cadr lst))
                                (setq sp (str-str-lst hd "-"))
                                (cond ((= (length sp) 1)
                                       (list hd 1 tl))
                                      ((= (length sp) 2)
                                       (list (car sp)(atoi (cadr sp)) tl))
                                      (t (list
                                           (vl-string-right-trim "-"
                                             (apply 'strcat
                                                    (mapcar
                                                      '(lambda(x)(strcat x "-"))
                                                      (reverse(cdr(reverse sp))))))
                                           (atoi (last sp)) tl))
                                      )
                                )
                             DataList)
            )
      (setq DataList (vl-sort DataList '(lambda(x y)(< (car x)(car y)))))
      (setq Datalist (mapcar '(lambda (x)
                (append x (list (* (cadr x)(caddr x)))))
              DataList))
  
      (setq sheet (xlsf DataList '("Поз" "Кол1" "Кол2" "Кол1*Кол2") nil "Стадия P" filename))
      (princ "\nДанные уже в Excell'е в листе ")(princ sheet)
      (setq DataList (mapcar '(lambda(x)(list (vl-string-trim "'" (car x))(last x))) DataList))
;_== Уплотняем >      
      (setq pat nil) 
      (mapcar '(lambda(x / hd) 
                 (if (setq hd (assoc (car x) pat)) 
                   (setq pat (subst (append (list(car x)) 
                                  (mapcar '+ (cdr hd)(cdr x))
                                            ) 
                          hd pat)) 
                   (setq pat (append pat (list x)))) 
                 ) 
              DataList) 
      (setq DataList pat) 
;_== Уплотняем <                   
      (setq DataList (mapcar '(lambda(x)(list (car x) ""  "" "" "" "" (cadr x))) DataList))
      (setq DataList (append (list '("")'("")'("")'("")) Datalist))
      (setq sheet (mip-conv-to-str(mip-reg-read "LASTXLSSHEET")))
      (setq sheet (xlsf DataList '("" "" "" "" "" ""  "") nil nil (list filename sheet)))
      (princ "\nДанные уже в Excell'е в листе ")(princ sheet)
      
      )
    )
  )
  (alert
   (strcat "Невозможно открыть\n" filename
           "\nУже открыт, отсутствует или не задан\nВыполните команду XLFileRmb"))
  )
  (princ)
  )

Нютка · 02.04.2007, 14:53

УРААААААААААААААААААААААААААА!!!!!!

Всё работает!
Как приятно было общаться с умным человеком. Ты - просто гений!!!!!
[sm2012]
ОГРОМНОЕ СПАСИБО!!!!!!!!!!!!!!!
Надеюсь, что смогу когда-нибудь такие програмки сама писать

Всем желаю удачи!!!!
[sm158]

27.03.2007, 17:38		#1
Нужна програмка для спецификации Нютка вед.инженер-технолог Москва Регистрация: 27.03.2007 Сообщений: 22 Нужна програмка для создания спецификации оборудования. Вопрос в следующем: есть план с расстановкой оборудования и номерами позиций. Позиции находятся на трёх слоях и представляют собой однострочный текст. Необходимо подсчитать количество этих позиций оборудования. Желательно, чтобы данные перенеслись в Excel, и представляли собой два столбца: 1 - номер позиции, 2 - количество. Помогите, а то я в программировании - ни бум-бум :cry: Заранее благодарю
Просмотров: 13053