[Нютка]

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

[Нютка]

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


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

[VVA]

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

[Нютка]

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

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

[VVA]

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

Код:

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

;|============================================================================= 
*    Функция преобразования набора, полученного через (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 загружены")

[Нютка]

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

[VVA]

Замени 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)
  )

[Нютка]

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



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