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

Нютка · 27.03.2007, 17:38

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

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

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

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск