[Kostinok]

Здравствуйте,
Не могу сообразить как заставить функция выполнять саму себя до тех пор, пока я ее не остановлю
Вот пример функции, которая заменяет Одни блоки на другие, и выполняется один раз

Код:

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

;; Замена блоков светильников общего освещения на светильники аварийного освещения
(defun ks_zam_avar (obj /  ang Name insPnt actdoc)
  (vl-load-com)
      (setq ang (vla-get-Rotation obj)
	    Name (vla-get-EffectiveName obj)
	    insPnt (vla-get-InsertionPoint obj)
	    actdoc (vla-get-ActiveDocument (vlax-get-acad-object))
	  )
    (vla-InsertBlock (vla-get-ModelSpace actdoc) insPnt (strcat Name "АВАР") 1 1 1 ang)
    (vla-Delete obj)
    )

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

Код:

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

(defun C:ks_zam (/ obj ks_zam_avar)
  (initget "Да Нет Yes No _Yes No Yes No")
  (if (= (getkword "\nЗаменить светильник? [Да/Нет] <Да> : ")
         "Yes"
      )
    (progn
      (setq obj (vlax-ename->vla-object (car (entsel "Укажите светильник: "))))
      (ks_zam_avar obj)
      (command "ks_zam" "")
     )
    )
  )

[zenon]

а просто в макросе кнопки перед командой поставить * не пойдет???

[Кулик Алексей aka kpblc]

Или использовать набор, например?

[Kostinok]

Кулик Алексей aka kpblc, Использовать набор не получиться, потому как нельзя заранее определить какие именно светильники придется заменить.
А почему происходит сбой программы? Не могу понять, ведь я их заранее определяю...
ЗЫ. Благодарю за помощь с _dwgru-getkword и dwgru-error-catch!!!! Если эти функции позволяют мне программно "Расставить" светильники по комнате, то эта функуция чтобы "Определить в комнате АВАРийные светильники", а для этого надо заменить один блок другим.

zenon, Этот вариант тоже не пойдет - потому что этот код лишь часть от другого и надо заставить его выполняться пока я не прерву функцию...

[ShaggyDoc]

Примерно так цикл делается:

Код:

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

 
(while
    (setq ent (entsel "Укажите светильник: "))
      (ks_zam_avar (vlax-ename->vla-object (car ent)))
   ;;;;;;;;  ??   (command "ks_zam" "") ;;шибко некрасиво и сомнительно. 
)

Только здесь штатную entsel лучше заменить на функцию, делающую то же самое, но с контролем ошибок на "промах" и нажатие ESC. Наверное в dwgru-lisp-lib есть

[Кулик Алексей aka kpblc]

Вариант:

Код:

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

(defun c:replace-block (/ adoc ent selset _dwgru-conv-pickset-to-list)


;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * _dwgru-conv-pickset-to-list
;;; *
;;; * 03/12/2007 Версия 0001. 
;;; ************************************************************************

  (defun _dwgru-conv-pickset-to-list (value / lst item)
;;; Назначение:
;;; Преобразовывает набор (pickset) в обычный список имен примитивов (ename)
;;; Низкоуровневая функция. Контроль соответствия типов не производится

;;; Параметры: 
;;; value - набор (pickset) или nil если пустой набор
;;; Возврат:
;;;   - список примитивов (Ename)
;;;; Пример
    ;|
(setq point (vla-addpoint (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-point '(0 0 0))))
(_dwgru-conv-pickset-to-list (ssget "_L")) ;_(<Имя объекта: 7ef85e00>)
(_dwgru-conv-pickset-to-list (ssadd)) ;_nil
  |;
    (repeat (setq item (sslength value)) ;_ end setq
      (setq lst (cons (ssname value (setq item (1- item))) lst))
      ) ;_ end repeat
    lst
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (and
      (=
        (type (setq
                ent (vl-catch-all-apply
                      '(lambda ()
                         (prompt
                           "\nВыбери блок, который будет вставляться <Отмена> : "
                           ) ;_ end of prompt
                         (ssget "_:S:E" '((0 . "INSERT")))
                         ) ;_ end of lambda
                      ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              ) ;_ end of type
        'pickset
        ) ;_ end of =
      (setq ent (assoc 2 (entget (ssname ent 0))))
      ) ;_ end of and
     (progn
       (while (setq selset (ssget '((0 . "INSERT"))))
         (foreach item (_dwgru-conv-pickset-to-list selset)
           (entmakex (subst ent
                            (assoc 2 (entget item))
                            (vl-remove-if
                              '(lambda (x)
                                 (member (car x) '(-1 5 330))
                                 ) ;_ end of LAMBDA
                              (entget item)
                              ) ;_ end of vl-remove-if
                            ) ;_ end of subst
                     ) ;_ end of entmakex
           (entdel item)
           ) ;_ end of foreach
         ) ;_ end of while
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

P.S. В файл уже должен быть вставлен блок, которым будет выполняться замещение (указывается первым). Слои должны быть разморожены и разблокированы.

[Kostinok]

Кулик Алексей aka kpblc,
После выполнения почему-то "Выбивает" AutoCAD. Блок вставляется, как я понял - анонимный.
Для ясности: На чертеже определено 4 динамических блока (условное обозначение светильников - с люминисцентными лампами и лампами накаливания - ЛЛ и ЛН и их аварийные дубликаты ЛЛ_АВАР и ЛН_АВАР, которые различаются цветом и подписью "А", где "А" - текст, который который можно двигать). Поскольку светильники могут быть разными, то в параметре Visibility Set тупо забиты названия светильников, и - если поменять параметр - условное обозначение светильника не изменится, меняется только параметр, т.е. "Тип светильника".
При расстановке блоков (сначала только ЛЛ или ЛН) благодоря твоей программе _kpblc-change-dyn-block-prop, и многим функциям с форума. Автоматически расстанавливаются светильники с уже заданными параметрами видимости , поэтому для того чтобы заменить всетильник необходимо, что бы вставляемый блок унаследовал все свойства заменяемого.
Вот что у меня получилось:

Код:

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

;| Замена блоков светильников общего освещения на светильники аварийного освещения
   c унаследованием свойств заменяемого.
   Светильники аварийного освещения НЕ ИМЕЮТ различия в параметре Visibility Set.
      Различия блоков: 
        1.В имени:  <Имя блока> и <Имя блока_АВАР>
        2. У аварийного светильника присутствует Point Parametr, т.е. динамических свойств у такого блока больше
|;
(defun C:ks_zam_avar ( / obj ang Name insPnt lstProperties actdoc obj_avar NProp Prop del_orig)
  (vl-load-com)
  (setq obj (vlax-ename->vla-object (car (entsel "Укажите светильник: "))))
  (if (and (vlax-property-available-p obj "IsDynamicBlock")
	   (= (vla-get-IsDynamicBlock obj) :vlax-true)
	   (setq ang (vla-get-Rotation obj)
		 Name (vla-get-EffectiveName obj)
		 insPnt (vla-get-InsertionPoint obj)
		 lstProperties (vlax-safearray->list
				 (variant-value
				   (vla-GetDynamicBlockProperties obj)
				   )
				 )
		 actdoc (vla-get-ActiveDocument (vlax-get-acad-object))
		 )
	   )
    (progn
      (setq obj_avar (vla-InsertBlock (vla-get-ModelSpace actdoc) insPnt (strcat Name "_АВАР") 1 1 1 ang)
	    NProp (vlax-safearray->list
				 (variant-value
				   (vla-GetDynamicBlockProperties obj_avar)
				   )
				 )
	    )
      (foreach item lstProperties
	(setq Prop (cons (car (vl-remove-if-not
				'(lambda (x) (= (strcase (vla-get-propertyname x)) (strcase (vla-get-propertyname item)));_ end of =
				   );_ end of lambda
				NProp);_ end vl-remove-if-not
			      );_ end car
			 Prop);_ end of cons
	      );_ end of setq
	);_ end of foreach
      (defun del_orig (nab /)
	(setq nab (vl-remove-if-not
		   '(lambda (x) (/= (strcase (vla-get-propertyname x)) (strcase "Origin"));_ end of =
		      );_ end of lambda
		   nab)
	    )
	nab
  )
      (setq Prop (del_orig Prop)
	    lstProperties (del_orig lstProperties)
	    )
      (repeat (setq item (length lstProperties)) ;_ end setq
	(vla-put-Value
	   (nth (- (length lstProperties) item) Prop)
	   (vla-get-value (nth (- item 1) lstProperties))
         )
	(setq item (1- item))
	);_ end repeat
      (vla-Delete obj)
      );_ end progn
    );_ end if
  );_ end defun

Немного не красиво с выбором светильников, как правильно заметил ShaggyDoc - как теперь "застраховаться от непопадания" незнаю .
Можт подскажешь ))))
От циклического выполнения отказался - вник советам - посадил на кнопку.

[Кулик Алексей aka kpblc]

По-моему, сначала не было сказано о том, что блоки динамические. Для них далеко не все так просто, как я нарисовал. Сейчас времени нет, может, попозже нарисую вариант.

[Volodich]

Kostinok, Приложи файл с блоками светильников. А лучше кусочек чертежа.
Я эту проблему по-другому решаю (т.к. программировать не умею ). У меня в параметре видимости как раз висит буква "А", а название светильника я вручную ввожу (в атрибут). А в аварийную сеть я его включаю просто перенося на другой слой (аварийное освещение).
Есть другой вариант если хочешь чтобы название светильника было в параметре видимости. Можно букву "А" просто масштабировать, чтобы в обычном варианте ее не было видно. Не знаю кем это придумано, первый раз я такое увидел в блоках у Krieger'а.
Прикладываю 2 варианта блока. Второй вариант очень сырой, просто для того чтобы показать принцип действия сказанного.

[Kostinok]

Volodich, Хотелось сделать так же как и у тебя, но тогда, как это обычно происходит, может подвести человеческий фактор - без него никуда, я отказался по 2-м причинам:
1. Постоянно прописывать имя своего светильника - ЛЕНЬ и можно легко наврать ведь, как я понимаю, атрибут "МАРКА" по идее НЕ видим;
Можно конечно задать несколько атрибутов с названиями светильников, ну а потом при выборе "такого-то типа", просто присвоить значение 1 атрибуту "такой-то тип", но тогда можно ставить и ставить, а вот удалять эти единички - забыться можно, и извлечь потом "чЁрти чЁ" - Тоже БРЕД.
2. Расставляя впопыхах блоки, забыть что ни будь исправить, и вставить с ошибкой.

Конечно, все эти ошибки я могу сделать и со своими блоками, но - своя рубашка ближе к телу..
Здесь на форуме есть очень много замечательных функций, благодаря которым, когда я вставляю светильник у меня сразу вылетает вопрос: "Какой тип светильника будем вставлять?", и выбирая из списка тип светильника и указывая точку вставки - получаю без проигрышный вариант Ну а расставив светильники одним кликом заменяю необходимые светильники аварийными, оставляя последние на том же слое (если надо слой можно поменять!).

Благодаря программе VVA, позволяющей извлекать из динамических блоков параметр видимости. Сразу получаю мощность и спецификацию.

В приложенной файле светильники.
Если идея понравилась могу скинуть - попробуешь.

[Volodich]

Kostinok, ты меня не понял. Я тебе просто идею показал как можно сделать по-другому.
Доделал свой блок до более понятного варианта.
Объясняю плюсы.
1) Работаешь точно так же, т.е. тип светильника "забит" в параметр видимости.
2) Атрибут я сделал для наглядности, чтобы как раз избежать ошибок.
3) Первоначально название светильника я сделал в атрибуте, т.к. я подумал, что сложно все возможные светильники перечислить будет сложно, а вдруг появится новый тип? Но с другой стороны наверное лучше когда они все уже перечислены и ты только выбираешь. А по мере появления новых светильников можно редактировать блок.
4) По поводу слоя... У меня они сразу разделены.
5) Не знаю, обратил ты внимание или нет, но у меня на весь светильник сделан wipeout, чтобы не рвать линию, на которой светильник "висит". Я тут на форуме нашел программку, которая "поднимает" все блоки с wipeout наверх. Если надо, приложу здесь.

Kostinok, выложи, пожалуйста, программку VVA, которая извлекает из дин блоков параметр видимости. Я сейчас пользуюсь EATTEXT, но это не очень удобно.

P.S. А у нас принято светильники типа ARS показывать квадратиками... не по ГОСТ, конечно, но зато понятно
И вопрос, как ты показываешь светильники с КЛК?

[Volodich]

Блин, блок-то забыл приложить
Да, еще забыл сказать, атрибут обновляется при регенерации чертежа.
Можно сделать чтобы обновлялся мгновенно (подсмотрел у Supermax), но это мороки много. Пока неохота делать. Нужно в каждой видимости прописать текст с маркой светильника. И делать его видимым только в данном представлении.

[Kostinok]

Volodich,
Идея с wipeout - СУПЕР!!! Огромное спасибо, делаешь, делаешь себе блоки всякие и все равно - что нибудь да упустишь, или не догадаешься вообще!!!
Для выбора примитивов пользуюсь программой Александра Ривилиса "ObjectARX. SelSim — выбор по образцу".

Вот код VVA, вызов - bcnt

Код:

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

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

А для работы кода нужно еще вот это

Код:

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

;;;Опубликовано  http://dwg.ru/f/showthread.php?t=17333
;;Возвращает список всех свойст динамического блока в виде списка
;((Имя_свойства Текущее_значение Vla_объект_свойства)...)
;; obj - Vla-указатель дин блока (vla-object)
;;Пример
;;(GetDynamicBlockPropertyList (vlax-ename->vla-object(car(entsel "\nВыбeри дин блок:"))))
;;(("Видимость" "Канализация" #<VLA-OBJECT IAcadDynamicBlockReferenceProperty 15246fe4>)
;;   ("Угол" 0.115395 #<VLA-OBJECT IAcadDynamicBlockReferenceProperty 15240fe4>) ...)
(defun GetDynamicBlockPropertyList (obj / lstProperties)
 (if (and (vlax-property-available-p obj "IsDynamicBlock")
          (= (vla-get-IsDynamicBlock obj) :vlax-true)
          (setq lstProperties (vlax-safearray->list 
                                           (variant-value 
                                            (vla-GetDynamicBlockProperties obj)))))
  (progn
   (mapcar '(lambda (x)(list (vla-get-propertyname X)
                             (variant-value (vla-get-value X))
                             x
                             )) 
           lstProperties))))

;; obj - Vla-указатель дин блока (vla-object)
;; PropertyName - имя свойства (string)
(defun GetDynamicBlockPropertyNameValue ( obj PropertyName / Plist)
  (and
  (setq PropertyName (strcase PropertyName))
  (setq Plist (GetDynamicBlockPropertyList obj))
  (setq Plist (car(vl-remove-if-not '(lambda (x)
                                   (= (strcase (car x)) PropertyName))
                Plist
                ))
        )
  )
   (cadr Plist)
)
(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)))))
;;;Подсчет динамических блоков по имени и значению динамического свойства
;;; http://dwg.ru/f/showthread.php?t=17333
;;;DynPropetyName - метка свойства (видимость и т.п.), строка - "Видимость"
;;;             или nil - считать по именам блоков
;;;             или список строк, если свойств несколько  - ("Марка балки" "Обозначение" "Профиль")
;;; IgnoreBlockNamePattern - строка, шаблон игнорируемых имен блоков или nil - все блоки
;;;                   Шаблон задается строкой, аналогично шаблону функции wcmatch
;;;                   Несколько шаблонов разделяются запятой
;;;                   Безразлична к регистру букв
;;;                   "A$C*,*НЕТ*,МАР*" - будут пропущены блоки с именами, начинающимися на A$C и МАР
;;;                   а тек же блоки, в имени которых есть сочетание НЕТ
;;;                  Шаблон для динамических блоков применяется к эффективному имени!!!
;;                   Примеры нескольких шаблонов
;;;                 "#* - исключить блоки, начинающиеся с цифры
;;;                 "#Бл* - исключить блоки, начинающиеся с цифры и следующие буквы которых БЛ (1Блок 2БЛОК и т.п.)
;;;                 "Формат" - исключить блок с именем формат
;;;                Возвращает список списков точечных пар, состоящих из
;;;                -  Имени блока и имени свойства, разделенных символом "|"
;;;                - количества
;;;                Пример
;;;               (("1Двутавр Широкополочный|25Ш1" . 2) ("Уголок равнополочный|50x5" . 3) ("Швеллер П|10П" . 1))
;; Или список нескольких свойств
;;;Пример вызова:
;;; (blockcount nil nil)
;;; (blockcount "Видимость" nil)
;;; (blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*,#*") ;_Игнорировать блоки, начинающиеся с A$C и цифры
;;; (blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*")  ;_Игнорировать блоки, начинающиеся с A$C
(defun blockcount (DynPropetyName IgnoreBlockNamePattern / adoc selset res name dynProp lst nameX)
  (vl-load-com)
  (setq IgnoreBlockNamePattern (strcase(mip-conv-to-str IgnoreBlockNamePattern)))
  (if (= (type DynPropetyName) 'STR)(setq DynPropetyName (list DynPropetyName)))
  (setq DynPropetyName (mapcar 'mip-conv-to-str DynPropetyName))
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if (setq selset (ssget '((0 . "INSERT"))))
    (progn
      (foreach blk
        (mapcar
   'vlax-ename->vla-object
   (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
        ) ;_ end of mapcar 
 (setq
   name (cond
   ((and (vlax-property-available-p blk 'isdynamicblock)
         (= (vla-get-isdynamicblock blk) :vlax-true)
    ) ;_ end of and
    (if (and DynPropetyName
             (listp DynPropetyName)
             )
      (setq DynProp (mapcar '(lambda (X)
             (GetDynamicBlockPropertyNameValue blk X)
                               )
                    DynPropetyName
                            )
      )
      (setq DynProp '("дин. блок"))
    )
    (vla-get-effectivename blk)
   )
   (t (setq DynProp '("обычный блок"))(vla-get-name blk))
        ) ;_ end of cond 
 ) ;_ end of setq
 (setq DynProp (vl-remove-if 'null DynProp))
 (if (not (wcmatch (strcase name) IgnoreBlockNamePattern))      
 (foreach DynP DynProp
   (setq nameX (strcat name "|" (mip-conv-to-str DynP)))
   (if (member nameX (mapcar 'car res))
     (setq res (subst (cons nameX (1+ (cdr (assoc nameX res))))
                      (assoc nameX res)
                      res
                      ) ;_ end of subst
           ) ;_ end of setq
     (setq res (append res (list (cons nameX 1))))
     ) ;_ end of if
   ) ;_ end of foreach DynP
   )
        ) ;_ end of foreach Blk
 
      (setq RR res)
      (setq
 name (mapcar '(lambda (x / p1 txt)
   (list
     (setq p1 (substr (setq txt (car x))
        1
        (vl-string-position 124 txt)
       )
     )
     (substr (VL-STRING-LEFT-TRIM p1 txt) 2)
     (itoa (cdr x))
   )
        )
       res
      )
      )
      (setq name (cons (list "Имя" "Значение" "Количество") name))
      (setq lst (mapcar '(lambda (a) (apply 'max (mapcar 'strlen a)))
   (apply 'mapcar (cons 'list name))
  )
      )
      (setq name (mapcar '(lambda (zz)
       (mapcar '(lambda (txt cnt)
           (setq cnt (+ cnt 3))
           (while (< (strlen txt) cnt)
      (setq txt (strcat txt " "))
           )
         )
        zz
        lst
       )
     )
    name
   )
      )
      (foreach item name
 (terpri)
 (mapcar 'princ item)
      ) ;_ end of foreach 
      (terpri)
      (princ)
    ) ;_ end of progn 
  ) ;_ end of if
(terpri)
  res
) ;_ end of defun

По поводу светильников:
(Возмущенно)
Ах вы

светильники типа ARS показывать квадратиками... не по ГОСТ, конечно, но зато понятно

....
Пришли ко мне как то планы архитекторов, там все такими вот светильниками, да еще не блоками, да еще из Архикада. Вот до сих пор вспоминаю Как я все это перебивал...

Светильники с КЛК никак не показываю, потому что к своему стыду не знаю, что такое КЛК и с чем его едят.

[Volodich]

Спасибо! Лисп-то нужен для поднятия всех блоков с wipeout наверх? Или он у тебя уже есть? Иначе если сначала поставишь светильник, а потом проведешь линию, она будет сверху.

Для выбора примитивов пользуюсь программой Александра Ривилиса "ObjectARX. SelSim — выбор по образцу".

Я тоже ею пользуюсь, вообще незаменимая вещь!
С извлечением попробую разобраться чуть позже. А что, список светильников будет в экселе?
Про КЛК извиняюсь, это я очепятался. Я имел ввиду КЛЛ - компактные люминисцентные лампы.
Кстати, предлагаю еще обменяться идеями и другими блоками. Будет поле для творчества. У меня есть по электрической части еще динамический разрез траншеи, выключатель и выноска списка кабелей. Хочу еще сделать толи разрез кабельного канала, толи просто блок стойка+полка динамический. Еще не решил. Какие еще можно сделать блоки для удобства работы пока не придумал.

[Makswell]

Сообщение от Volodich Спасибо! Лисп-то нужен для поднятия всех блоков с wipeout наверх? Или он у тебя уже есть? Иначе если сначала поставишь светильник, а потом проведешь линию, она будет сверху.

Volodich, а ты это не смотрел? В своё время Алексей написал программу как раз для такого случая.

[Kostinok]

Volodich,
Да список будет состоять из наименования блоков и их состояния Visibility Set-а. Обязательно попробуй, должно понравиться.
КЛЛ - используем очееееееень редко, настолько, что я еще ни разу не использовал).
В блоках у меня Выключатели нагрузки, Выключатели напряжения, Штепсельные розетки, Щиты, Узлы прокладки траншей.
Хотел спросить: Как решаешь вопрос со спецификацией? Сделано, что нибудь для увеличения производительности?
Просто у меня есть некоторые идеи, но думаю, что они слишком трудоемкие. Может что подскажешь...
По блокам вроде все. А вот с поднятием наверх:
Можно выбрать все свои светильники, потом правой кнопкой и Bring to Front. Может и не правильно, но свои блоки пока еще не подправил. Програмку пожалуйста скинь.

[Volodich]

Makswell, Да, да, это оно! Именно эта функция! Kostinok, рекомендую ту тему почитать и взять себе на вооружение.

Можно выбрать все свои светильники, потом правой кнопкой и Bring to Front.

Можно и так, но это гораздо муторнее.
Если не жалко, выложи свои блоки, я свои. Обсудим. Со спецификацией это пока проблема. Автоматически не могу пока придумать как заполнять. Пока проще SelSlim-мом выделять и считать.
Как считать кабели особая проблема.
1. Для внутрянки можно делать слои 2х1,5; 3х1.5; 4х1,5 и т.п. Чертить четко в этих слоях, а потом общую длину смотреть программкой GeomPrompts. С поправками, конечно.
2. Я в основном делаю внешние сети, поэтому пользуюсь программкой FDIST - без нее вообще не могу. Хотя и наши "внутрянщики" уже попривыкли и говорят не представляют себе как без нее работать. Суть - тыкаешь мышкой в точки прохождения кабеля, а программка сама считает длину трассы с учетом масштаба.

Расскажи свои трудоемкие идеи, подумаем.