Нужно посчитать приборы

Нужно посчитать приборы · 23.09.2008, 10:51

Возникла задача считать приборы. Похожую программу сделал мне Alaspher тут но теперь мне нужно считать приборы. Все то же самое. Должна быть таблица в которй будут посчитаны содержимое однострочных текстов. Например НМШ2-4000, НМШ1-1440 и их количество. Все остальные тексты игнор. Может кто поможет с программой?

В программе должны быть две колонки. В первой название прибора (для примера достаточно пока двух - остальные я сам могу вбить) во второй количество этих приборов.

Donhuan · 23.09.2008, 23:18

Пробуй. На основе программы Alaspher-а.

Код:

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

(defun c:сpribor (/ adoc alay asel dat fst lock mod pnt row tbl tmp)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        asel (vla-get-activeselectionset adoc)
        alay (vla-get-activelayer adoc)
  )
  (vla-clear asel)
  (vla-startundomark adoc)
  (pl:obj-select-on-screen asel "TEXT")
  (vlax-for i asel
    (if (wcmatch (setq i (vla-get-textstring i)) "????-####") 
       (setq dat (if (setq tmp (assoc i dat))
                   (subst (cons (car tmp) (1+ (cdr tmp))) tmp dat)
                   (cons (cons i 1) dat)
                 )
       )
    )
  )
  (if (and dat
           (setq pnt (vl-catch-all-apply
                       (function getpoint)
                       '("Точка вставки таблицы <Отказаться>: ")
                     )
           )
           (not (vl-catch-all-error-p pnt))
      )
    (progn
      (if (= (vla-get-lock alay) :vlax-true)
        (progn (vla-put-lock alay :vlax-false) (setq lock t))
      )
      (if (setq fst (vla-item asel 0)
                mod (vla-get-height fst)
                tbl (vla-addtable
                      (vla-objectidtoobject adoc (vla-get-ownerid fst))
                      (vlax-3d-point (trans pnt 1 0))
                      (+ (length dat) 2)
                      2
                      (* 1.8 mod)
                      (* 9.6 mod)
                    )
          )
        (progn
          (vla-put-regeneratetablesuppressed tbl :vlax-true)
          (vla-settext tbl 0 0 "Спецификация приборов")
          (vla-setcellalignment tbl 0 0 acmiddlecenter)
          (vla-setcelltextheight tbl 0 0 mod)
          (vla-settext tbl 1 0 "Марка")
          (vla-settext tbl 1 1 "Число")
          (vla-setcellalignment tbl 1 0 acmiddlecenter)
          (vla-setcellalignment tbl 1 1 acmiddlecenter)
          (vla-setcelltextheight tbl 1 0 mod)
          (vla-setcelltextheight tbl 1 1 mod)
          (vla-setcolumnwidth tbl 1 (* 6.0 mod))
          (vla-put-horzcellmargin tbl (* 0.4 mod))
          (setq row 1)
          (foreach i dat
            (vla-settext tbl (setq row (1+ row)) 0 (car i))
            (vla-setcellalignment tbl row 0 acmiddlecenter)
            (vla-setcelltextheight tbl row 0 mod)
            (vla-settext tbl row 1 (cdr i))
            (vla-setcellalignment tbl row 1 acmiddleright)
            (vla-setcelltextheight tbl row 1 mod)
          )
          (vla-put-regeneratetablesuppressed tbl :vlax-false)
          (vla-update tbl)
        )
      )
      (if lock
        (vla-put-lock alay :vlax-true)
      )
    )
  )
  (vla-endundomark adoc)
  (princ)
)
(defun pl:obj-select-on-screen (sel enttype)
  (vla-selectonscreen
    sel
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) (list enttype))
  )
)

Shoorup · 24.09.2008, 09:36

Donhuan, спасибо - то, что нужно. Еще вопросик, как мне добавить игнорирование тех надписей которые находятся на defpoints?
PS. Как мне добавить список конкретных приборов? "????-####" - такое поле не пойдет. Нужны конкретные имена. Пусть их будет даже 1000, но это четкие имена.

Donhuan · 24.09.2008, 16:37

Без "Defpoints":

Код:

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

(defun c:lpribor (/ adoc alay asel dat fst lock mod pnt row tbl tmp)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        asel (vla-get-activeselectionset adoc)
        alay (vla-get-activelayer adoc)
  )
  (vla-clear asel)
  (vla-startundomark adoc)
  (pl:obj-select-on-screen asel "TEXT")
  (vlax-for i asel
    (if (wcmatch (setq i (vla-get-textstring i)) "????-####") 
       (setq dat (if (setq tmp (assoc i dat))
                   (subst (cons (car tmp) (1+ (cdr tmp))) tmp dat)
                   (cons (cons i 1) dat)
                 )
       )
    )
  )
  (if (and dat
           (setq pnt (vl-catch-all-apply
                       (function getpoint)
                       '("Точка вставки таблицы <Отказаться>: ")
                     )
           )
           (not (vl-catch-all-error-p pnt))
      )
    (progn
      (if (= (vla-get-lock alay) :vlax-true)
        (progn (vla-put-lock alay :vlax-false) (setq lock t))
      )
      (if (setq fst (vla-item asel 0)
                mod (vla-get-height fst)
                tbl (vla-addtable
                      (vla-objectidtoobject adoc (vla-get-ownerid fst))
                      (vlax-3d-point (trans pnt 1 0))
                      (+ (length dat) 2)
                      2
                      (* 1.8 mod)
                      (* 9.6 mod)
                    )
          )
        (progn
          (vla-put-regeneratetablesuppressed tbl :vlax-true)
          (vla-settext tbl 0 0 "Спецификация приборов")
          (vla-setcellalignment tbl 0 0 acmiddlecenter)
          (vla-setcelltextheight tbl 0 0 mod)
          (vla-settext tbl 1 0 "Марка")
          (vla-settext tbl 1 1 "Число")
          (vla-setcellalignment tbl 1 0 acmiddlecenter)
          (vla-setcellalignment tbl 1 1 acmiddlecenter)
          (vla-setcelltextheight tbl 1 0 mod)
          (vla-setcelltextheight tbl 1 1 mod)
          (vla-setcolumnwidth tbl 1 (* 6.0 mod))
          (vla-put-horzcellmargin tbl (* 0.4 mod))
          (setq row 1)
          (foreach i dat
            (vla-settext tbl (setq row (1+ row)) 0 (car i))
            (vla-setcellalignment tbl row 0 acmiddlecenter)
            (vla-setcelltextheight tbl row 0 mod)
            (vla-settext tbl row 1 (cdr i))
            (vla-setcellalignment tbl row 1 acmiddleright)
            (vla-setcelltextheight tbl row 1 mod)
          )
          (vla-put-regeneratetablesuppressed tbl :vlax-false)
          (vla-update tbl)
        )
      )
      (if lock
        (vla-put-lock alay :vlax-true)
      )
    )
  )
  (vla-endundomark adoc)
  (princ)
)
(defun pl:obj-select-on-screen (sel enttype)
  (vla-selectonscreen
    sel
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 3)) '(0 -4 8 -4))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 3)) (list enttype "<NOT" "Defpoints" "NOT>"))
  )
)

Насчет шаблонов (wcmatch "проверяемый текст" "шаблон1,шаблон2 и т.д."). Подставляй вместо шаблонов свои наименования и вперед.

Shoorup · 25.09.2008, 14:16

Donhuan, а что за проверяемый текст?

Shoorup · 25.09.2008, 15:32

Спасибо большое разобрался.
А можно мне еще доработать программу и сделать ссылку на экселевский файл. Я бы в нем в столбик перечислил бы приборы - так удобней отследить недостающих приборов и отсортировать их хоть както.
Идея похоже есть тут

Donhuan · 26.09.2008, 14:46

Не совсем понял что надо. Извлечь из файла список наименований приборов и передать в его в качестве шаблонов?

Shoorup · 26.09.2008, 17:12

Да. Просто в экселе структуированно будет как-то все. Просто в текстовом файле не удобно.

Donhuan · 27.09.2008, 03:36

Используя функцию Евгения Елпанова.

Код:

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

(setq *dir_custom* "D:\\"); начальный путь поиска
(setq *way_custom* nil); вставить путь, например, "D:\\4.xls"
(defun c:lpribor (/ adoc alay asel dat fst lock mod pnt row tbl tmp pattern)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        asel (vla-get-activeselectionset adoc)
        alay (vla-get-activelayer adoc)
	pattern (get_pattern)
  )
  (vla-clear asel)
  (vla-startundomark adoc)
  (pl:obj-select-on-screen asel "TEXT")
  (vlax-for i asel
    (if (wcmatch (setq i (vla-get-textstring i)) pattern) 
       (setq dat (if (setq tmp (assoc i dat))
                   (subst (cons (car tmp) (1+ (cdr tmp))) tmp dat)
                   (cons (cons i 1) dat)
                 )
       )
    )
  )
  (if (and dat
           (setq pnt (vl-catch-all-apply
                       (function getpoint)
                       '("Точка вставки таблицы <Отказаться>: ")
                     )
           )
           (not (vl-catch-all-error-p pnt))
      )
    (progn
      (if (= (vla-get-lock alay) :vlax-true)
        (progn (vla-put-lock alay :vlax-false) (setq lock t))
      )
      (if (setq fst (vla-item asel 0)
                mod (vla-get-height fst)
                tbl (vla-addtable
                      (vla-objectidtoobject adoc (vla-get-ownerid fst))
                      (vlax-3d-point (trans pnt 1 0))
                      (+ (length dat) 2)
                      2
                      (* 1.8 mod)
                      (* 9.6 mod)
                    )
          )
        (progn
          (vla-put-regeneratetablesuppressed tbl :vlax-true)
          (vla-settext tbl 0 0 "Спецификация приборов")
          (vla-setcellalignment tbl 0 0 acmiddlecenter)
          (vla-setcelltextheight tbl 0 0 mod)
          (vla-settext tbl 1 0 "Марка")
          (vla-settext tbl 1 1 "Число")
          (vla-setcellalignment tbl 1 0 acmiddlecenter)
          (vla-setcellalignment tbl 1 1 acmiddlecenter)
          (vla-setcelltextheight tbl 1 0 mod)
          (vla-setcelltextheight tbl 1 1 mod)
          (vla-setcolumnwidth tbl 1 (* 6.0 mod))
          (vla-put-horzcellmargin tbl (* 0.4 mod))
          (setq row 1)
          (foreach i dat
            (vla-settext tbl (setq row (1+ row)) 0 (car i))
            (vla-setcellalignment tbl row 0 acmiddlecenter)
            (vla-setcelltextheight tbl row 0 mod)
            (vla-settext tbl row 1 (cdr i))
            (vla-setcellalignment tbl row 1 acmiddleright)
            (vla-setcelltextheight tbl row 1 mod)
          )
          (vla-put-regeneratetablesuppressed tbl :vlax-false)
          (vla-update tbl)
        )
      )
      (if lock
        (vla-put-lock alay :vlax-true)
      )
    )
  )
  (vla-endundomark adoc)
  (princ)
)
(defun pl:obj-select-on-screen (sel enttype)
  (vla-selectonscreen
    sel
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 3)) '(0 -4 8 -4))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 3)) (list enttype "<NOT" "Defpoints" "NOT>"))
  )
)

(defun get_pattern ( / x)
  ;Функция получения шаблона "1,2..." из списка вида (("..." ("1") ("2"))...)
  (setq x
	 (vl-remove-if
	   '(lambda (x)
	      (not (= (type x) 'STR)))
	   (mapcar 'car
		   (apply 'append
			  (mapcar 'cdr
				  (GET_xl
				    (if *way_custom*
				      *way_custom*
				      (getfiled "Выберите файл, содержащий список шаблонов" *dir_custom* "xls" 8)
				    )
				  )
			  )
		   )
	   )
	 )
  )
  (strcat_from_list x)
)

(defun strcat_from_list (l)
; функция сцепки строк содержащихся в списке ("1" "2" "3" ...) в "1,2..."
  (cond
    ((null l) nil)
    ((null (cdr l)) (car l))
    (t (strcat (car l) "," (strcat_from_list (cdr l))))
  )
)

;|
     GET_XL.LSP
     Created by Elpanov Evgeny
     842@list.ru
     elpanov@gmail.com

Data reading from Microsoft Excel not using Excel.
This code, can read diverse data from all tables.

 ARGUMENTS:
 A string containing a complete file name, including the path.
 (setq tbl "D:\\4.xls")

 USAGE:
 (GET_xl tbl)

 RETURN VFALUES
 The list of all pages in a file with all data
|;
(defun rec-rem-dupl (lst)
 (if lst
  (cons (car lst) (rec-rem-dupl (vl-remove (car lst) (cdr lst))))
 ) ;_  if
) ;_  defun
(defun GET_xl (tbl / ADOCONNECT ADORECORDSET LST)
 (setq ADOConnect   (vlax-get-or-create-object "ADODB.Connection")
       ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
 ) ;_  setq
 (if
  (not (vl-catch-all-error-p
        (vl-catch-all-apply (function vlax-invoke-method)
                            (list ADOConnect
                                  "Open"
                                  (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
                                          tbl
                                          ";Extended Properties=;Excel 8.0;HDR=No"
                                  ) ;_  strcat
                                  "admin"
                                  ""
                                  nil
                            ) ;_  list
        ) ;_  vl-catch-all-apply
       ) ;_  vl-catch-all-error-p
  ) ;_  not
  (progn (setq
          lst (mapcar
               (function (lambda (l / i c)
                          (vlax-invoke-method ADORecordset
                                              "Open"
                                              (strcat "SELECT * FROM [" l "]")
                                              ADOConnect
                                              1
                                              3
                                              nil
                          ) ;_  vlax-invoke-method
                          (setq i
                                (length
                                 (car (vlax-safearray->list
                                       (vlax-variant-value (vlax-invoke-method ADORecordset "GetRows" 65535) ;_  vlax-invoke-method
                                       ) ;_  vlax-variant-value
                                      ) ;_  vlax-safearray->list
                                 ) ;_  car
                                ) ;_  length
                          ) ;_  setq
                          (vlax-invoke-method ADORecordset "Close")
                          (while (not (zerop i))
                           (vlax-invoke-method
                            ADORecordset
                            "Open"
                            (strcat "SELECT * FROM [" l "a" (itoa i) ":IV" (itoa i) "]")
                            ADOConnect
                            1
                            3
                            nil
                           ) ;_  vlax-invoke-method
                           (setq c (cons
                                    (car
                                     (apply
                                      (function mapcar)
                                      (cons
                                       'list
                                       (mapcar
                                        (function (lambda (a)
                                                   (mapcar (function (lambda (b) (vlax-variant-value b)) ;_  lambda
                                                           ) ;_  function
                                                           a
                                                   ) ;_  mapcar
                                                  ) ;_  lambda
                                        ) ;_  function
                                        (vlax-safearray->list
                                         (vlax-variant-value (vlax-invoke-method ADORecordset "GetRows" 65535) ;_  vlax-invoke-method
                                         ) ;_  vlax-variant-value
                                        ) ;_  vlax-safearray->list
                                       ) ;_  mapcar
                                      ) ;_  cons
                                     ) ;_  apply
                                    ) ;_  car
                                    c
                                   ) ;_  cons
                                 i (1- i)
                           ) ;_  setq
                           (vlax-invoke-method ADORecordset "Close")
                          ) ;_  while
                          (if (equal c '((nil) (nil)))
                           (list l)
                           (cons l c)
                          ) ;_  if
                         ) ;_  lambda
               ) ;_  function
               (mapcar
                (function (lambda (x)
                           (if (= (substr x 1 1) "'")
                            (substr x 2 (- (strlen x) 2))
                            x
                           ) ;_  if
                          ) ;_  lambda
                ) ;_  function
                (rec-rem-dupl
                 (caddr
                  (mapcar (function (lambda (a)
                                     (mapcar (function vlax-variant-value) a) ;_  mapcar
                                    ) ;_  lambda
                          ) ;_  function
                          (vlax-safearray->list
                           (vlax-variant-value
                            (vlax-invoke-method (vlax-invoke-method ADOConnect "OpenSchema" 4) ;_  vlax-invoke-method
                                                "GetRows"
                                                65535
                            ) ;_  vlax-invoke-method
                           ) ;_  vlax-variant-value
                          ) ;_  vlax-safearray->list
                  ) ;_  apply
                 ) ;_  caddr
                ) ;_  rec-rem-dupl
               ) ;_  mapcar
              ) ;_  mapcar
         ) ;_  setq
         (vlax-invoke-method ADOConnect "Close")
         (vlax-release-object ADORecordset)
         (vlax-release-object ADOConnect)
         (setq ADORecordset nil
               ADOConnect nil
         ) ;_  setq
         lst
  ) ;_  progn
  (progn (vl-catch-all-apply 'vlax-invoke-method (list ADOConnect "Close")) ;_  vl-catch-all-apply
         (vlax-release-object ADORecordset)
         (vlax-release-object ADOConnect)
         (setq ADORecordset nil
               ADOConnect nil
         ) ;_  setq
         nil
  ) ;_  progn
 ) ;_  if
) ;_  defun

Shoorup · 21.10.2008, 15:38

Цитата:

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

Используя функцию Евгения Елпанова.

Код:

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

(setq *dir_custom* "D:\\"); начальный путь поиска
(defun c:lpribor (/ adoc alay asel dat fst lock mod pnt row tbl tmp pattern)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-gкet-acad-object))
        asel (vla-get-activeselectionset adoc)
        alay (vla-get-activelayer adoc)
	pattern (get_pattern)
  )
  (vla-clear asel)
  (vla-startundomark adoc)
  (pl:obj-select-on-screen asel "TEXT")
  (vlax-for i asel
    (if (wcmatch (setq i (vla-get-textstring i)) pattern) 
       (setq dat (if (setq tmp (assoc i dat))
                   (subst (cons (car tmp) (1+ (cdr tmp))) tmp dat)
                   (cons (cons i 1) dat)
                 )
       )
    )
  )
  (if (and dat
           (setq pnt (vl-catch-all-apply
                       (function getpoint)
                       '("Точка вставки таблицы <Отказаться>: ")
                     )
           )
           (not (vl-catch-all-error-p pnt))
      )
    (progn
      (if (= (vla-get-lock alay) :vlax-true)
        (progn (vla-put-lock alay :vlax-false) (setq lock t))
      )
      (if (setq fst (vla-item asel 0)
                mod (vla-get-height fst)
                tbl (vla-addtable
                      (vla-objectidtoobject adoc (vla-get-ownerid fst))
                      (vlax-3d-point (trans pnt 1 0))
                      (+ (length dat) 2)
                      2
                      (* 1.8 mod)
                      (* 9.6 mod)
                    )
          )
        (progn
          (vla-put-regeneratetablesuppressed tbl :vlax-true)
          (vla-settext tbl 0 0 "Спецификация приборов")
          (vla-setcellalignment tbl 0 0 acmiddlecenter)
          (vla-setcelltextheight tbl 0 0 mod)
          (vla-settext tbl 1 0 "Марка")
          (vla-settext tbl 1 1 "Число")
          (vla-setcellalignment tbl 1 0 acmiddlecenter)
          (vla-setcellalignment tbl 1 1 acmiddlecenter)
          (vla-setcelltextheight tbl 1 0 mod)
          (vla-setcelltextheight tbl 1 1 mod)
          (vla-setcolumnwidth tbl 1 (* 6.0 mod))
          (vla-put-horzcellmargin tbl (* 0.4 mod))
          (setq row 1)
          (foreach i dat
            (vla-settext tbl (setq row (1+ row)) 0 (car i))
            (vla-setcellalignment tbl row 0 acmiddlecenter)
            (vla-setcelltextheight tbl row 0 mod)
            (vla-settext tbl row 1 (cdr i))
            (vla-setcellalignment tbl row 1 acmiddleright)
            (vla-setcelltextheight tbl row 1 mod)
          )
          (vla-put-regeneratetablesuppressed tbl :vlax-false)
          (vla-update tbl)
        )
      )
      (if lock
        (vla-put-lock alay :vlax-true)
      )
    )
  )
  (vla-endundomark adoc)
  (princ)
)
(defun pl:obj-select-on-screen (sel enttype)
  (vla-selectonscreen
    sel
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 3)) '(0 -4 8 -4))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 3)) (list enttype "<NOT" "Defpoints" "NOT>"))
  )
)

(defun get_pattern ( / x)
  ;Функция получения шаблона "1,2..." из списка вида (("..." ("1") ("2"))...)
  (setq x
	 (vl-remove-if
	   '(lambda (x)
	      (not (= (type x) 'STR)))
	   (mapcar 'car
		   (apply 'append
			  (mapcar 'cdr
				  (GET_xl
				    (getfiled "Выберите файл, содержащий список шаблонов" *dir_custom* "xls" 8)
				  )
			  )
		   )
	   )
	 )
  )
  (strcat_from_list x)
)

(defun strcat_from_list (l)
; функция сцепки строк содержащихся в списке ("1" "2" "3" ...) в "1,2..."
  (cond
    ((null l) nil)
    ((null (cdr l)) (car l))
    (t (strcat (car l) "," (strcat_from_list (cdr l))))
  )
)

;|
     GET_XL.LSP
     Created by Elpanov Evgeny
     842@list.ru
     elpanov@gmail.com

Data reading from Microsoft Excel not using Excel.
This code, can read diverse data from all tables.

 ARGUMENTS:
 A string containing a complete file name, including the path.
 (setq tbl "D:\\4.xls")

 USAGE:
 (GET_xl tbl)

 RETURN VFALUES
 The list of all pages in a file with all data
|;
(defun rec-rem-dupl (lst)
 (if lst
  (cons (car lst) (rec-rem-dupl (vl-remove (car lst) (cdr lst))))
 ) ;_  if
) ;_  defun
(defun GET_xl (tbl / ADOCONNECT ADORECORDSET LST)
 (setq ADOConnect   (vlax-get-or-create-object "ADODB.Connection")
       ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
 ) ;_  setq
 (if
  (not (vl-catch-all-error-p
        (vl-catch-all-apply (function vlax-invoke-method)
                            (list ADOConnect
                                  "Open"
                                  (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
                                          tbl
                                          ";Extended Properties=;Excel 8.0;HDR=No"
                                  ) ;_  strcat
                                  "admin"
                                  ""
                                  nil
                            ) ;_  list
        ) ;_  vl-catch-all-apply
       ) ;_  vl-catch-all-error-p
  ) ;_  not
  (progn (setq
          lst (mapcar
               (function (lambda (l / i c)
                          (vlax-invoke-method ADORecordset
                                              "Open"
                                              (strcat "SELECT * FROM [" l "]")
                                              ADOConnect
                                              1
                                              3
                                              nil
                          ) ;_  vlax-invoke-method
                          (setq i
                                (length
                                 (car (vlax-safearray->list
                                       (vlax-variant-value (vlax-invoke-method ADORecordset "GetRows" 65535) ;_  vlax-invoke-method
                                       ) ;_  vlax-variant-value
                                      ) ;_  vlax-safearray->list
                                 ) ;_  car
                                ) ;_  length
                          ) ;_  setq
                          (vlax-invoke-method ADORecordset "Close")
                          (while (not (zerop i))
                           (vlax-invoke-method
                            ADORecordset
                            "Open"
                            (strcat "SELECT * FROM [" l "a" (itoa i) ":IV" (itoa i) "]")
                            ADOConnect
                            1
                            3
                            nil
                           ) ;_  vlax-invoke-method
                           (setq c (cons
                                    (car
                                     (apply
                                      (function mapcar)
                                      (cons
                                       'list
                                       (mapcar
                                        (function (lambda (a)
                                                   (mapcar (function (lambda (b) (vlax-variant-value b)) ;_  lambda
                                                           ) ;_  function
                                                           a
                                                   ) ;_  mapcar
                                                  ) ;_  lambda
                                        ) ;_  function
                                        (vlax-safearray->list
                                         (vlax-variant-value (vlax-invoke-method ADORecordset "GetRows" 65535) ;_  vlax-invoke-method
                                         ) ;_  vlax-variant-value
                                        ) ;_  vlax-safearray->list
                                       ) ;_  mapcar
                                      ) ;_  cons
                                     ) ;_  apply
                                    ) ;_  car
                                    c
                                   ) ;_  cons
                                 i (1- i)
                           ) ;_  setq
                           (vlax-invoke-method ADORecordset "Close")
                          ) ;_  while
                          (if (equal c '((nil) (nil)))
                           (list l)
                           (cons l c)
                          ) ;_  if
                         ) ;_  lambda
               ) ;_  function
               (mapcar
                (function (lambda (x)
                           (if (= (substr x 1 1) "'")
                            (substr x 2 (- (strlen x) 2))
                            x
                           ) ;_  if
                          ) ;_  lambda
                ) ;_  function
                (rec-rem-dupl
                 (caddr
                  (mapcar (function (lambda (a)
                                     (mapcar (function vlax-variant-value) a) ;_  mapcar
                                    ) ;_  lambda
                          ) ;_  function
                          (vlax-safearray->list
                           (vlax-variant-value
                            (vlax-invoke-method (vlax-invoke-method ADOConnect "OpenSchema" 4) ;_  vlax-invoke-method
                                                "GetRows"
                                                65535
                            ) ;_  vlax-invoke-method
                           ) ;_  vlax-variant-value
                          ) ;_  vlax-safearray->list
                  ) ;_  apply
                 ) ;_  caddr
                ) ;_  rec-rem-dupl
               ) ;_  mapcar
              ) ;_  mapcar
         ) ;_  setq
         (vlax-invoke-method ADOConnect "Close")
         (vlax-release-object ADORecordset)
         (vlax-release-object ADOConnect)
         (setq ADORecordset nil
               ADOConnect nil
         ) ;_  setq
         lst
  ) ;_  progn
  (progn (vl-catch-all-apply 'vlax-invoke-method (list ADOConnect "Close")) ;_  vl-catch-all-apply
         (vlax-release-object ADORecordset)
         (vlax-release-object ADOConnect)
         (setq ADORecordset nil
               ADOConnect nil
         ) ;_  setq
         nil
  ) ;_  progn
 ) ;_  if
) ;_  defun

С первой ошибкой справился.

Код:

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

(setq adoc (vla-get-activedocument (vlax-get-acad-object))

А вот со второй не знаю что делать. Возможно я неправильно чтото делаю просто. Как должен выглядеть шаблон?
Ошибка такая: ошибка: "Ошибка Automation. BOF или EOF имеет значение True, либо текущая
запись удалена. Для выполняемой операции требуется текущая запись."

Donhuan · 21.10.2008, 19:04

Ума не приложу откуда взялась опечатка, в меня в исходном коде все правильно. Заменил код в предыдущем ответе, попробуй может пройдет без ошибок.

Shoorup · 22.10.2008, 12:11

Всеравно ошибка лезет - Ошибка Automation. BOF или EOF имеет значение True, либо текущая
запись удалена. Для выполняемой операции требуется текущая запись

Как делаю. Создал екселевский файл. В нем записал в столбик пару названий приборов. Запускаю программу. она просит указать екселевский файл. указываю. ругается.

Donhuan · 22.10.2008, 16:44

Ошибка происходит до появления запроса в ком. строке "select object:" (то есть до выбора объектов на чертеже)?

Кулик Алексей aka kpblc · 22.10.2008, 23:15

Может, офис не той версии? 2007 вместо 2003 (или наоборот)
Или по умолчанию xls открывается не Excel'ем (код не смотрел, поэтому не уверен в точности рецептов)

Donhuan · 23.10.2008, 01:08

Функция от Евгения Елпанова по его словам должна работать даже при отсутствии Exel.
Я потому и спросил, когда ошибка, если сбой связан с этой функцией, то я лично помочь навряд ли смогу.

Кулик Алексей aka kpblc · 23.10.2008, 08:39

А, точно. Забыл, забыл...

Alaspher · 23.10.2008, 09:47

Может MDAC окривел или несовместимой версии?

Shoorup · 23.10.2008, 18:10

Программа работает. Только не удобно. Нужно сначало выбрать объекты, а потом дать команду считать приборы. Можно ли наоборот сделать? Еще я так понял приборы нужно записывать только в первый столбец -приборы из другого столбца не считаются (впринципе мне нравится ничего менять не нужно).
Если вместе с выбираемыми объектами попал не текст то программа дает ошибку.
Еще очень хочется ввести для себя пометки чтоли. Т.е. добавить те приборы которые возможно ввели не правильно. Например есть прибор НМШ2-4000. Часто при проектировании еще не известно какой прибор будет стоять и пишут просто НМШ. Можно ли сделать так, чтобы например я сделал столбец ошибок в экселе (например E). и в таблице посчитанных приборов под отдельным заголовком (графой) шли эти самые ошибки. Это не горит и не сильно нужно - просто пожелание к программе.

Donhuan · 24.10.2008, 16:04

Что-то не понял первого вопроса. Последовательность действий такая:
1. Указать файл шаблонов.
2. Указать объекты.
3. Указать точку вставки таблицы.
Надо 2-1-3?
Действительно из экселевского файла читаются данные только из первой колонки каждого листа. С чем это связано и как сделать по другому не знаю.
Ничего кроме текста на чертеже выбрать в принципе нельзя. Какие объекты кроме текста попадают в набор?
Трудность реализации последнего предложения связана для меня с тем, что, как писал выше, не разбирался и не уверен что смогу разобраться, как работает функция Евгения Елпанова.

Shoorup · 24.10.2008, 16:41

Если делать 1,2,3 дает ошибку. Надо чтоб в лиспе уже был прописан шаблон - он один. У меня сделана кнопка на этот лисп. Должно работать так: нажал кнопку, выбрал объекты, указал точку вставки таблицы.
А работает так. Выбрал обекты, нажал кнопку, указал где шаблон, указал точку вставки таблицы.

Donhuan · 11.11.2008, 19:56

Извиняюсь, что долго не отвечал - не было времени.
Дополненный код в #9.
Добавил глобальную переменную *way_custom*, если отлична от nil, то диалог с выбором файла в программе будет пропускаться. Для этого в код вместо (setq *way_custom* nil) надо вставить, например, (setq *way_custom* "D:\\book.xls"), то есть путь к своему файлу-шаблону.
Макрос для кнопки, если код помещен в файл lpribor.lsp и данный файл находится в каталогах поддержки:

Код:

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

^C^C(if (not *dir_custom*) (load "lpribor.lsp")) lpribor

Насчет выбора объектов: у меня ошибки не возникает. Если имеются предварительно выбранные объекты, то после вызова функции операции будут производиться с этими объектами, если выбранных объектов до вызова нет, то будет предложено выбрать объекты.

Shoorup · 13.11.2008, 17:00

Не работает всеравно...
Ошибка Automation. BOF или EOF имеет значение True, либо текущая
запись удалена. Для выполняемой операции требуется текущая запись.

Donhuan · 13.11.2008, 17:18

Так в #18 работала же?

Shoorup · 13.11.2008, 18:31

Цитата:

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

Так в #18 работала же?

с учетом изменений после #21 не работает

Donhuan · 13.11.2008, 21:20

Судя по тому, что у тебя возникает такая же ошибка как и в #12 и ты ее в дальнейшем как-то поборол самостоятельно, посоветовать ничего не могу, так как это точно не связано с теми незначительными дополнениями которые я внес. У меня все работает.

Shoorup · 14.11.2008, 10:30

Вроде разобрался. Проблему не могу решить при условии что программа и файл эксселя лежит не в корне диска. Закидываю все в корень С:\ все работает, если перекидываю все C:\ShSCB то не работает.
Так должна выглядеть первая строка в лиспе?

Код:

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

(setq *dir_custom* "C:\\ShSCB\") ; начальный путь поиска
(setq *way_custom* "C:\\ShSCB\lpribor.xls")

чую что ошибка именно тут.
При запуске в корне С:\ появляется экселевский файл размером в 6 кило который не удаляется (пока кад работает) и не открывается.

Alaspher · 14.11.2008, 10:56

Цитата:

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

Так должна выглядеть первая строка в лиспе?

Код:

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

(setq *dir_custom* "C:\\ShSCB\") ; начальный путь поиска
(setq *way_custom* "C:\\ShSCB\lpribor.xls")

Не вникая в детали, только по формату записи, если добавлять каталог, то должно быть так:

Код:

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

(setq *dir_custom* "C:\\ShSCB\\") ; начальный путь поиска
(setq *way_custom* "C:\\ShSCB\\lpribor.xls")

Shoorup · 14.11.2008, 11:29

Alaspher, спасибо! Заработало. Остальное подкрутить "под себя" вполне сам смогу.
Donhuan, спасибо большое за программу! Всё работает как надо.

Елпанов Евгений · 14.11.2008, 11:29

Вот ведь...
Бывает же!

Функцию чтения *.xls я писал только с одной целью - показать Алексею Кулику, что это возможно! Все было без проверок и в два раза короче, чем в последней версии... С одной стороны, я люблю эксель, как очень удобный калькулятор, но ненавижу его, как программу, для связи с акадом! Для таких целей, во много раз удобнее использовать базы данных. Каждый раз, когда меня просят адаптировать эту программу к каким либо новым условиям или исправить ошибки - мне приходится долго собираться с духом - мне противна сама возможность связки акада и экселя...

PS. Самая последняя версия программы:
Data reading from Microsoft Excel not using Excel.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Приборы, применяемые при обследованиях зд. и соор.	Arslan	Обследование зданий и сооружений	29	15.04.2021 20:17
Нужно посчитать кабель	Shoorup	Программирование	122	06.02.2020 14:09
Нужно ли показывать с спецификации болты, гвозди, анкеры?	Колян	Прочее. Архитектура и строительство	9	14.09.2006 08:09
Дали задачку на плаксисе посчитать	rust-resisting	Прочее. Программное обеспечение	1	25.03.2006 13:42

23.09.2008, 10:51		#1
Нужно посчитать приборы Shoorup Минск Регистрация: 16.09.2006 Сообщений: 1,587 Возникла задача считать приборы. Похожую программу сделал мне Alaspher тут но теперь мне нужно считать приборы. Все то же самое. Должна быть таблица в которй будут посчитаны содержимое однострочных текстов. Например НМШ2-4000, НМШ1-1440 и их количество. Все остальные тексты игнор. Может кто поможет с программой? В программе должны быть две колонки. В первой название прибора (для примера достаточно пока двух - остальные я сам могу вбить) во второй количество этих приборов. __________________ Поезд который устал от ржавого здравомыслия рельсов... Последний раз редактировалось Shoorup, 23.09.2008 в 11:01.
Просмотров: 5717