| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Сквозная нумерация динамических блоков

Сквозная нумерация динамических блоков

Ответ
Поиск в этой теме
Непрочитано 18.09.2007, 17:45 #1
Сквозная нумерация динамических блоков
zenon
 
Остекляем!!! Алюминим!!!
 
Москва
Регистрация: 21.02.2005
Сообщений: 3,824

Назрело!
В связи с введением динамических блоков начиная с AutoCAD2006, по роду моей деятельности появилась возможность рисовать монтажную схему стоек с указание ее длины в аттрибуте, с автоматическим изменением аттрибута в зависимости от удлинения стойки.
Поэтому назрел вопрос о сквозной нумерации, то бищь присвоении 2му аттрибуту номера стойки в зависимости от ее длины.
см. чертеж
[ATTACH]1190123036.dwg[/ATTACH]
Можно ли расстановку позиций реализовать программно?
ps предварительно расставив стойки.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
Просмотров: 88198
 
Непрочитано 18.09.2007, 23:17
#2
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


конечно можно, самому нуно но пока еще руки не дошли.
Sleekka вне форума  
 
Автор темы   Непрочитано 19.09.2007, 10:57
#3
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Просто я лиспом не занимался некогда, вот поэтому и прошу помощи.
Для себя вроде алгоритм работы программы вроде сложил
1. Расстановка стоек(дин. блоков)
2. Регенерировать чертеж.
3. Запуск функции обсчета длин и количества стоек, с соответвующим привязками к блокам.
4. Нумерация поз. стоек.
5. Обратная вставка в атрибут поз. соответвующего блока

ps команда _attout из ЕТ [ATTACH]1190184972.jpg[/ATTACH] выкидывает тхт файл с значением атрибутов дин.блоков,
Код:
[Выделить все]
HANDLE	BLOCKNAME	DLINA
'2FB	*U15	1864.3
'2ED	*U15	1864.3
'2DF	*U15	1864.3
'2D1	*U15	1864.3
'2C3	*U15	1864.3
'2B5	*U17	541.8
'2A7	*U17	541.8
'299	*U17	541.8
'28B	*U17	541.8
'27D	*U9	3229.6
'26F	*U9	3229.6
'261	*U9	3229.6
'253	*U9	3229.6
'17E	*U17	541.8
'170	*U15	1864.3
'162	*U13	953.9
'154	*U11	1193.3
'88	*U9	3229.6
вот как бы загнать обратно с позициями??
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 19.09.2007, 11:53
#4
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Стоп, так задача какая получается? Юзер меняет длину дин.блока, внутрь блока в атрибуты (к примеру, LEN и NUM):
- LEN -> вбить значение линейного параметра
- NUM -> вбить номер позиции:?:
Если с первой частью в общем-то трудности никакой, то со второй - проблема. Как определять номер позиции? Допустим, стоит 2 стойки, у одной длина 100, у другой - 101. Какие номера и по какому закону назначать?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 19.09.2007, 12:40
#5
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Цитата:
Сообщение от Кулик Алексей aka kpblc
Стоп, так задача какая получается? Юзер меняет длину дин.блока, внутрь блока в атрибуты (к примеру, LEN и NUM):
- LEN -> вбить значение линейного параметра
- NUM -> вбить номер позиции:?:
Если с первой частью в общем-то трудности никакой, то со второй - проблема. Как определять номер позиции? Допустим, стоит 2 стойки, у одной длина 100, у другой - 101. Какие номера и по какому закону назначать?
Немного не так, юзер не меняет длину сам он тока тянет за ручку, а при обновлении атрибут отвечающий за длину сам пересчитывается,
1 пункт - LEN -> вбить значение линейного параметра отпадает сам. ( в чертеже можно посмотреть реализацию данного пункта)
а вот программка должная сама вставлять номер поз. в зависимости от полученной длины (зависимость можно по возрастанию или убыванию длины)
то бишь
LEN 1000 - 5шт, прогамма NUM - 1
LEN 1454 - 5шт, прогамма NUM - 2
LEN 2111 - 5шт, прогамма NUM - 3
LEN 5252 - 5шт, прогамма NUM - 4
LEN 2222 - 5шт, прогамма NUM - 5
LEN 5555 - 5шт, прогамма NUM - 6

где LEN вычисляется через поле в зависимости от длины стойки.

ps а в примере я что-то не так пояснил???
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 19.09.2007, 13:19
#6
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Я попробовал вставить атрибут-поле, привязанное к значению линейного параметра, но не получилось. Может, что не так делал, но значения вообще не показывались - только "по умолчанию". Сейчас попробую накатать вариант (если успею, правда).
Без простановки номеров позиций получилось следующе <...> Фигня получилась из-за глюка када.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 19.09.2007, 14:47
#7
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


попробую поподробнее, то как это вижу я.
1. Программа вытаскивает из блоков значение длинн, (промежуточный файл али буфер)
2. Сортирует по возрастанию или убыванию, сортировка должна идти совместно с именем блока (он вроде анонимный), для последующей корректной вставки поз. (дублирующие длины наверно можно удалить)
3. Присваивает значение поз. по длине (на дублирующие длины поз. одинаковы)
4. И собственно присваивает атрибуту соответсвующего блока значение поз.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Автор темы   Непрочитано 19.09.2007, 15:51
#8
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


мотеж это поможет.
Как это вручную происходит
1. Создан дин.блок с 2 атрибутами:
а) - DLINA вычисляет длину стойки через поле;
б) - POZ указатель позиции
2. Вставка блоков и удлинение соотвественно.
3. Визульная сортировка по значению длин.
4. Выписка значений длин на бумажку и простановка напротив позиции, одинаковым длинам присваивается одинаковый номер позиции.
5. Присваивание атрибуту POZ блока с соответсвующей длиной значения указанного в бумажке.
6. Присваивание атрибуту POZ блока с соответсвующей длиной значения указанного в бумажке.
7. Присваивание атрибуту POZ блока с соответсвующей длиной значения указанного в бумажке.
8.
9.
10.
.
.
.
.
.
N.


Вот хотелось бы начиная с 3 пункта автоматизировать.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 19.09.2007, 16:15
#9
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Я только что вернулся, так что сажусь за решение 2-й части. Кстати, мой вопрос сможешь решить? Как сделать внутри блока атрибут-поле, показывающее значение линейного параметра? У меня в ADT2006Rus не получилось.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 19.09.2007, 16:31
#10
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Цитата:
Сообщение от Кулик Алексей aka kpblc
Кстати, мой вопрос сможешь решить? Как сделать внутри блока атрибут-поле, показывающее значение линейного параметра?
не совсем понял вопрос.
у меня, в примере, вставлен атрибут с полем, которое отслеживает длину линии.
[ATTACH]1190205108.jpg[/ATTACH]
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 19.09.2007, 16:42
#11
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Какого ляда тогда у меня 2006-й не обновлял? Я чего и голову-то ломал. Так, ща переделаю...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 19.09.2007, 16:45
#12
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


я после изменения длины запускал _regenall
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 19.09.2007, 16:47
#13
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Да простят меня собеседники, вклинюсь.
Если есть некий элемент, у которого в зависимости от длинны меняется марка, то реализовать это можно в самом динблоке. Длины при этом фиксированные и выбираются в раскрывающемся списке, при этом изменяется и сама форма элемента и разные другие ее параметры типа вес, марка и т.п.
Далее:
Если мы имеем некоторую позицию на чертеже и ее надо обозначить номером или буквенным описанием, то тогда в дин. блок вставляются атрибуты, изменение данных в которых к изменению номера*U123 не приводят и на подсчет не влияют.
Скачайте мой 3D динамический блок трубы в ППУ изоляции ду-159 из DWG.RU Downloads/Чертежи/Библиотека элементов и посмотрите как он сделан.
Supermax вне форума  
 
Непрочитано 19.09.2007, 16:51
#14
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


И Господа! Не смешивайте атрибуты блока со свойсвами изделия представленными в виде данных 3D элемента!
Одно дело мы присваиваем 3D элементу характеристики изделия и совсем другое, когда мы ему присваиваем данные о принадлежности и месторасположении в моделе.
Supermax вне форума  
 
Автор темы   Непрочитано 19.09.2007, 16:54
#15
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Цитата:
Сообщение от Supermax
Да простят меня собеседники, вклинюсь.
Если есть некий элемент, у которого в зависимости от длинны меняется марка, то реализовать это можно в самом динблоке. Длины при этом фиксированные и выбираются в раскрывающемся списке, при этом изменяется и сама форма элемента и разные другие ее параметры типа вес, марка и т.п.
Далее:
Если мы имеем некоторую позицию на чертеже и ее надо обозначить номером или буквенным описанием, то тогда в дин. блок вставляются атрибуты, изменение данных в которых к изменению номера*U123 не приводят и на подсчет не влияют.
Скачайте мой 3D динамический блок трубы в ППУ изоляции ду-159 из DWG.RU Downloads/Чертежи/Библиотека элементов и посмотрите как он сделан.
1 - ну а если неизвестно какие длины? и их количество, каждый раз рисовать и присваивать?? Хорошо кода есть несколько типоразмеров!!
2 - как известно измененный блок через лисп видится как *Unnn, а вдруг вставлено несколько блоков у которых длина одинакова, но имя разное?? что тогда??
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 19.09.2007, 17:03
#16
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Попробуйте
Код:
[Выделить все]
(defun try-to-renum (source
                     res
                     /
                     selset
                     adoc
                     pos
                     ent_lst
                     _kpblc-conv-vla-to-list
                     _kpblc-block-attr-get-pointer-mask
                     _kpblc-is-ent-block-with-attr
                     _kpblc-is-ent-block-with-constant-attr
                     _kpblc-property-get
                     _kpblc-property-set
                     _kpblc-conv-value-to-string
                     )
                    ;|
*    Простановка позиций с повторами для блоков
*    Параметры вызова:
   source   тэг атрибута, критичного к простановке (например, DLINA)
   res   тэг атрибута, куда устанавливается значение позиции
*    Примеры вызова:
(try-to-renum "dlina" "pos")
|;

  (defun _kpblc-conv-value-to-string (value /)
                                     ;|
*    конвертация значения в строку.
|;
    (if value
      (vl-princ-to-string value)
      ""
      ) ;_ end of if
    ) ;_ end of defun

  (defun _kpblc-error-catch (protected-function
                             on-error-function
                             /
                             catch_error_result
                             )
                            ;|
*** Функция взята из книжной версии ruCAD'a без каких бы то ни было переделок,
*** кроме переименования.
*    Оболочка отлова ошибок.
*    Параметры вызова:
*   protected-function   - "защищаемая" функция
*   on-error-function   - функция, выполняемая в случае ошибки
|;
    (setq catch_error_result (vl-catch-all-apply protected-function))
    (if (and (vl-catch-all-error-p catch_error_result)
             on-error-function
             ) ;_ end of and
      (apply on-error-function
             (list (vl-catch-all-error-message catch_error_result))
             ) ;_ end of apply
      catch_error_result
      ) ;_ end of if
    ) ;_ end of defun

  (defun _kpblc-error-print (func-name msg)
                            ;|
*    Функция вывода сообщения об ошибке для (_kpblc-error-catch)
*    Параметры вызова:
*   func-name   имя функции, в которой возникла ошибка
*   msg      сообщение об ошибке
|;
    (princ (strcat "\n ** "
                   (strcase func-name t)
                   " ERROR #"
                   (if msg
                     (strcat
                       (_kpblc-conv-value-to-string (getvar "errno"))
                       ": "
                       (_kpblc-conv-value-to-string msg)
                       ) ;_ end of strcat
                     ": undefined"
                     ) ;_ end of if
                   "\n"
                   ) ;_ end of strcat
           ) ;_ end of princ
    (princ)
    ) ;_ end of defun

  (defun _kpblc-property-set (obj property value / res)
                             ;|
*    Установка значения свойства объекта.
*    Параметры вызова:
*   obj      указатель на объект
*   property   наименование свойства
*   value      устанавливаемое значение
|;
    (_kpblc-error-catch
      (function
        (lambda ()
          (if (and obj
                   (vlax-property-available-p
                     obj
                     property
                     t
                     ) ;_ end of vlax-property-available-p
                   (vlax-read-enabled-p obj)
                   (vlax-write-enabled-p obj)
                   (not (vlax-erased-p obj))
                   ) ;_ end of and
            (progn
              (vlax-put-property
                obj
                property
                (cond
                  ((or (= (type value) (type (vlax-get-property obj property)))
                       (and (member (type value) (list 'int 'real))
                            (member (type (vlax-get-property obj property))
                                    (list 'int 'real)
                                    ) ;_ end of member
                            ) ;_ end of and
                       ) ;_ end of or
                   value
                   )
                  ((and (= (type (vlax-get-property obj property)) 'variant)
                        (member (type (car (_kpblc-conv-vla-to-list value)))
                                (list 'int 'real)
                                ) ;_ end of member
                        ) ;_ end of and
                   (vlax-3d-point (_kpblc-conv-vla-to-list value))
                   )
                  ((= (type (vlax-get-property obj property)) 'variant)
                   ((lambda (/ temp value_type)
                      (setq temp (_kpblc-conv-vla-to-list value))
                      (vlax-make-variant
                        (vlax-safearray-fill
                          (vlax-make-safearray
                            (cond ((= (type (car temp)) 'real) vlax-vbdouble)
                                  ((= (type (car temp)) 'int) vlax-vbinteger)
                                  ((= (type (car temp)) 'str) vlax-vbstring)
                                  (t vlax-vbobject)
                                  ) ;_ end of cond
                            (cons 0 (1- (length temp)))
                            ) ;_ end of vlax-make-safearray
                          temp
                          ) ;_ end of vlax-safearray-fill
                        ) ;_ end of vlax-make-variant
                      ) ;_ end of lambda
                    )
                   )
                  ) ;_ end of cond
                ) ;_ end of vlax-put-property
              ) ;_ end of if
            (setq res (vlax-get-property obj property))
            ) ;_ end of if
          ) ;_ end of lambda
        ) ;_ end of function
      '(lambda (x)
         (_kpblc-error-print
           (strcat
             "_kpblc-property-set :"
             " obj->"
             (_kpblc-conv-value-to-string (_kpblc-property-get obj 'objectname))
             " property->"
             (_kpblc-conv-value-to-string property)
             " value-> "
             (_kpblc-conv-value-to-string value)
             ) ;_ end of strcat
           x
           ) ;_ end of _kpblc-error-print
         ) ;_ end of lambda
      ) ;_ end of _kpblc-error-catch
    res
    ) ;_ end of defun

  (defun _kpblc-property-get (obj property / res)
                             ;|
*    Получение значения свойства объекта
|;
    (_kpblc-error-catch
      (function
        (lambda ()
          (if (and obj
                   (vlax-property-available-p
                     obj
                     property
                     ) ;_ end of vlax-property-available-p
                   ) ;_ end of and
            (setq res (vlax-get-property obj property))
            ) ;_ end of if
          ) ;_ end of lambda
        ) ;_ end of function
      '(lambda (x)
         (if (_kpblc-is-debug-mode)
           (_kpblc-error-print
             (strcat "_kpblc-property-get :"
                     " obj->"
                     (_kpblc-conv-value-to-string
                       (if (vlax-property-available-p
                             obj
                             'objectname
                             ) ;_ end of vlax-property-available-p
                         (vla-get-objectname obj)
                         obj
                         ) ;_ end of if
                       ) ;_ end of _kpblc-conv-value-to-string
                     " property->"
                     (_kpblc-conv-value-to-string property)
                     ) ;_ end of strcat
             x
             ) ;_ end of _kpblc-error-print
           ) ;_ end of if
         ) ;_ end of lambda
      ) ;_ end of _kpblc-error-catch
    res
    ) ;_ end of defun

  (defun _kpblc-is-ent-block-with-attr (ent)
                                       ;|
*    Функция проверяет, является ли переданный указатель блоком и есть ли в нем
* изменяемые атрибуты
*    ent   указатель на проверяемый примитив
|;
    (and
      (= (strcase (vla-get-objectname ent) t) "acdbblockreference")
      (= (_kpblc-property-get ent 'hasattributes) :vlax-true)
      (> (vlax-safearray-get-u-bound
           (vlax-variant-value (vla-getattributes ent))
           1
           ) ;_ end of vlax-safearray-get-u-bound
         -1
         ) ;_ end of >
      ) ;_ end of and
    ) ;_ end of defun

  (defun _kpblc-is-ent-block-with-constant-attr (ent)
                                                ;|
*    Функция проверяет, является ли переданный указатель блоком с постоянными атрибутами
*    Параметры вызова:
*   ent   указатель на вхождение блока
|;
    (and (= (strcase (vla-get-objectname ent) t) "acdbblockreference")
         (vlax-method-applicable-p ent 'getconstantattributes)
         (> (vlax-safearray-get-u-bound
              (vlax-variant-value (vla-getconstantattributes ent))
              1
              ) ;_ end of vlax-safearray-get-u-bound
            -1
            ) ;_ end of >
         ) ;_ end of and
    ) ;_ end of defun

  (defun _kpblc-block-attr-get-pointer-mask (blk mask / res)
                                            ;|
*    Получение списка атрибутов блока по маске. Учитываются также постоянные атрибуты.
*    Параметры вызова:
*   blk   указатель на вставку блока
*   mask   строка с маской тэга атрибута
|;
    (if (_kpblc-is-ent-block-with-attr blk)
      (setq res
             (vl-sort
               (vl-remove-if-not
                 '(lambda (x)
                    (wcmatch (strcase (_kpblc-property-get x 'tagstring))
                             (strcase mask)
                             ) ;_ end of wcmatch
                    ) ;_ end of lambda
                 (vlax-safearray->list (vlax-variant-value (vla-getattributes blk)))
                 ) ;_ end of vl-remove-if-not
               '(lambda (a b)
                  (< (strcase (_kpblc-property-get a 'tagstring))
                     (strcase (_kpblc-property-get b 'tagstring))
                     ) ;_ end of <
                  ) ;_ end of lambda
               ) ;_ end of vl-sort
            ) ;_ end of setq
      ) ;_ end of if
    (if (_kpblc-is-ent-block-with-constant-attr blk)
      (setq
        res
         (append res
                 (vl-sort
                   (vl-remove-if-not
                     '(lambda (x)
                        (wcmatch (strcase (_kpblc-property-get x 'tagstring))
                                 (strcase mask)
                                 ) ;_ end of wcmatch
                        ) ;_ end of lambda
                     (vlax-safearray->list
                       (vlax-variant-value (vla-getconstantattributes blk))
                       ) ;_ end of vlax-safearray->list
                     ) ;_ end of vl-remove-if-not
                   '(lambda (a b)
                      (< (strcase (_kpblc-property-get a 'tagstring))
                         (strcase (_kpblc-property-get b 'tagstring))
                         ) ;_ end of <
                      ) ;_ end of lambda
                   ) ;_ end of vl-sort
                 ) ;_ end of cons
        ) ;_ end of setq
      ) ;_ end of if
    res
    ) ;_ end of defun

  (defun _kpblc-conv-vla-to-list (value / res)
                                 ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (vlax-safearray->list value)
         ) ;_ end of if
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (vl-load-com)
  (if (setq selset (ssget "_:L" '((0 . "INSERT") (66 . 1))))
    (progn
      (foreach ent (setq ent_lst
                          (vl-remove-if-not
                            '(lambda (x)
                               (equal (vla-get-isdynamicblock (car x)) :vlax-true)
                               ) ;_ end of lambda
                            (vl-sort
                              (mapcar
                                '(lambda (a)
                                   (cons
                                     (setq a (vlax-ename->vla-object a))
                                     (_kpblc-property-get
                                       (car (_kpblc-block-attr-get-pointer-mask
                                              a
                                              source
                                              ) ; _ end of
                                            ) ;_ end of car
                                       'textstring
                                       ) ;_ end of _kpblc-property-get
                                     ) ;_ end of cons
                                   ) ;_ end of lambda
                                (vl-remove-if
                                  'listp
                                  (mapcar 'cadr (ssnamex selset))
                                  ) ;_ end of vl-remove-if
                                ) ;_ end of mapcar
                              '(lambda (a b)
                                 (< (cdr a) (cdr b))
                                 ) ;_ end of lambda
                              ) ;_ end of vl-sort
                            ) ;_ end of vl-remove-if-not
                         ) ;_ end of setq
        (_kpblc-property-set
          (car (_kpblc-block-attr-get-pointer-mask (car ent) res))
          'textstring
          (_kpblc-conv-value-to-string
            (setq
              pos (cond
                    ((= (length ent_lst) (length (member ent ent_lst)))
                     1
                     )
                    (t
                     (if (= (cdr ent)
                            (cdr (nth (1- (- (length ent_lst)
                                             (length (member ent ent_lst))
                                             ) ;_ end of -
                                          ) ;_ end of 1+
                                      ent_lst
                                      ) ;_ end of nth
                                 ) ;_ end of cdr
                            ) ;_ end of =
                       pos
                       (setq pos (1+ pos))
                       ) ;_ end of if
                     )
                    ) ;_ end of cond
              ) ;_ end of setq
            ) ;_ end of _kpblc-conv-value-to-string
          ) ;_ end of _kpblc-property-set
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
---
Отредактировал: убрал дубликаты объявлений функций вне основной.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.09.2007, 17:27
#17
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Да хоть и то и другое.
Можно выноску зеркалить легким поглаживанием по ручке, можно и вес и марку и еще черте-что менять. Один дин. блок может заменить все типы изделий в линейке!
Вот глянь и дальше поговорим.
[ATTACH]1190208436.dwg[/ATTACH]
Supermax вне форума  
 
Непрочитано 19.09.2007, 17:37
#18
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Про разные имена и одинаковую длинну.
Есть в каде одна дырка, которую я успешно залатал. Это, когда вставляешь инсертом дин. блок, он по началу имеет скажем так "техническое" имя такое же как и то, которым вы его окрестили. Стоит только его параметры пошевелить, как он становится *Unnn. Если при этом его параметры вернуть к исходному значению он так и останется *Unnn. Вот если в этот момент опять вставить этот же блок, получается ситуация, когда в модели два одинаковых блока, но с разными именами. Я написал маленький макрос, который синхронизирует имя вставленного блока и делает его *Unnn, причем, если в модели уже есть такой U, то номер станет его. Номер этого U всегда будет привязан к состоянию его свойств (вот состояние атрибутов блока на U не влияют). Если накопировать кучу блоков, пошевелить всем параметры, а потом вернуть, у всех будет один и тот же U номер.
Supermax вне форума  
 
Непрочитано 19.09.2007, 17:49
#19
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


> Supermax : А ты обращайся не к Name, а к EffectiveName и будет счастие и благолепие.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.09.2007, 18:15
#20
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Не будет. Если динамическим блоком сделать скажем всю серию ФБС, меняя в этом блоке тип ФБС мы тем самым меняем и его сущность, а EffectiveName при этом будет называться "Блоки ФБС" Какие? - можно узнать только прочтя свойства. Или сделать столько блоков, сколько существует видов ФБС.
Supermax вне форума  
 
Непрочитано 19.09.2007, 18:21
#21
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


В первом выложенном файле не нашел атрибута для позиции. Добавил в блок артибут POZ. Ну и соответственно лисп

Код:
[Выделить все]
;_ Numbering of Dynamic Blocks 
(defun c:NDB ( / adoc ss res name bname atname lst lstLen att poz attTo 
               mip-block-setattr-bylist 
              mip-put-hyperlink 
              mip_MakeUniqueMembersOfList 
              member-i 
              get-all-atts 
              mip-conv-to-str
              *error*
              )
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
 (vl-load-com)   
  (setq bname "Stoyka") ;_Имя блока 
  (setq atname "Dlina") ;_Имя аттрибута откуда брать 
  (setq attTo "Poz") ;_Имя аттрибута куда вбивать

  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  ;; obj - Ename or Vla object of block 
;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...) 
;;                 Tag_Name - string 
;;                    Value - string 
(defun *error* (msg)(princ msg)(vla-EndUndoMark adoc))
(defun mip-block-setattr-bylist (obj att_list / txt lst) 
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj))) 
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list)) 
  (if (and obj 
           (not(vlax-erased-p obj)) 
           (= (vla-get-ObjectName obj) "AcDbBlockReference") 
      (eq :vlax-true (vla-get-HasAttributes obj)) 
      (vlax-property-available-p obj 'Hasattributes) 
      (vlax-write-enabled-p obj) 
      ) 
    (vl-catch-all-apply 
      (function 
   (lambda   () 
          (foreach at (vlax-invoke obj 'Getattributes) 
            (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list)) 
              (vla-put-TextString at (cdr lst)) 
            ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
(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 mip-put-hyperlink (ENAME URLDescription) 
  (if (eq (type ENAME) 'ENAME) 
    (setq ENAME (vlax-ename->vla-object ENAME)) 
  ) ;_ end of if 
  (vlax-for hyp (vla-get-hyperlinks ENAME) (vla-delete hyp)) 
  (vla-add (vla-get-hyperlinks ENAME) 
           "about:blank" 
           URLDescription 
  ) ;_ end of vla-add 
) ;_ end of DEFUN 

;;;Удаляет одинаковые (дубликаты) элементы из списка 
;;;(defun mip_MakeUniqueMembersOfList  ( lst / OutList head) 
;;;  (while lst 
;;;    (setq head (car lst) 
;;;          lst (vl-remove head lst) 
;;;          OutList (append OutList (list head)))) 
;;;  OutList 
;;;  ) 
(defun mip_MakeUniqueMembersOfList  ( lst / OutList head) 
  (while lst 
    (setq head (car lst) 
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6)) lst) 
          OutList (append OutList (list head)))) 
  OutList 
  ) 
(defun member-i ( lst num / i) 
 (setq i 0)(while (and lst (not(equal (car lst) num 1e-6))) 
    (setq i (1+ i) lst(cdr lst))) 
  (if (equal (car lst) num 1e-6) i nil)) 
  (defun get-all-atts (obj) 

  (if (and obj 
      (eq :vlax-true (vla-get-HasAttributes obj)) 
      (vlax-property-available-p obj 'Hasattributes) 
       
      ) 
    (vl-catch-all-apply 
      (function 
   (lambda   () 
     (mapcar (function (lambda (x) 
               (cons (vla-get-TagString x) 
                (vla-get-TextString x) 
               ) 
             ) 
        ) 
        (append (vlax-invoke obj 'Getattributes) 
           (vlax-invoke obj 'Getconstantattributes) 
        ) 
     ) 
   ) 
      ) 
    ) 
  ) 
) 
;;;============================================================= 
;;;====================== MAIN PART ============================ 
;;;============================================================= 
  (vla-StartUndoMark adoc)
  (setq *PREF* (mip-conv-to-str *PREF*))
  (setq *SUFF* (mip-conv-to-str *SUFF*))
  (princ "\nВведите префикс или Пробел - нет <")(princ *PREF*)(princ ">: ")
  (setq *PREF* (getstring t))
  (princ "\nВведите суффикс или Пробел - нет :")(princ *SUFF*)(princ ">: ")
  (setq *SUFF* (getstring t))
  (if (= *PREF* " ")(setq *PREF* "") t)(if (= *SUFF* " ")(setq *SUFF* "") t)         
  (if (and (setq ss (ssget  '((0 . "INSERT")(66 . 1))))
           (setq lstLen (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
           )
    (progn
      (vla-regen adoc acactiveviewport)    
;;;      (setq ss nil)
;;;      (vl-cmdf "_.UPDATEFIELD")
;;;      (foreach blk lstlen (vl-cmdf blk))(vl-cmdf "")
      (foreach blk 
               (mapcar 'vlax-ename->vla-object lstlen) ;_ end of mapcar 
        (setq name (cond 
                     ((and (vlax-property-available-p blk 'isdynamicblock) 
                           (= (vla-get-isdynamicblock blk) :vlax-true) 
                           ) ;_ end of and 
                      (vla-get-effectivename blk) 
                      ) 
                     (t (vla-get-name blk)) 
                     ) ;_ end of cond 
              ) ;_ end of setq 
        (if (= (strcase name)(strcase bname)) 
          (setq lst (cons blk lst))) 
         ;_ end of if 
        ) ;_ end of foreach 
      (setq lstLen (mapcar '(lambda(x)(cdr(assoc (strcase atname)(get-all-atts x)))) lst)) 
      (setq lstLen (vl-remove-if 'null lstLen)) 
      (setq lstLen (mapcar 'atof lstLen)) 
      (setq lstLen (mip_MakeUniqueMembersOfList lstLen)) 
      (setq lstLen (vl-sort lstLen '(lambda(a b)(< a b)))) 
      (princ "\n Позиция  Длинна")(setq poz 1) 
      (foreach blk lstlen 
        (princ "\n")(princ poz)(princ "  -  ")(princ blk) 
        (setq poz (1+ poz)) 
        ) 
      (foreach blk lst 
        (if (and 
              (setq att(cdr(assoc (strcase atname)(get-all-atts blk)))) 
              (setq att (atof att)) 
              (setq poz (member-i lstlen att)) 
              ) 
          (progn 
            ;_Маркиреум 
            (mip-put-hyperlink blk (itoa(1+ poz))) 
            (mip-block-setattr-bylist blk
              (list (cons (strcase attTo)(strcat *PREF* (itoa(1+ poz)) *SUFF*)))) 
            ) 
          ) 
        ) 
      ) ;_ end of progn 
    ) ;_ end of if
  (vla-EndUndoMark adoc)
  (princ) 
  )
*** ИЗМЕНЕНО 20.09.2007
1. Добавлены пропущенные ф-ции
2. Добавлен выбор объектов
3. Предварительно обновляются поля блоков

*** ИЗМЕНЕНО 21.09.2007
1. Добавлена регенерация, суффикс, префикс
[ATTACH]1190211834.dwg[/ATTACH]
VVA вне форума  
 
Непрочитано 19.09.2007, 18:27
#22
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Вот если выноски так сделать как я сделал, то тогда действительно, пошевелил выноску и U поменялось. Два одинаковых блока с разностоящими выносками называются по разному.
Supermax вне форума  
 
Непрочитано 19.09.2007, 18:28
#23
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Ага, а GetDynamicProperties сделано для красоты? Мой код проанализируй построчно.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.09.2007, 18:35
#24
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Нет округления длин. Если длинна оличается от другой на пол миллиметра, то что и номер у нее должен быть другой?
Supermax вне форума  
 
Автор темы   Непрочитано 19.09.2007, 18:38
#25
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


2 VVA
чейто у меня вот
Код:
[Выделить все]
Command: NDB
; error: no function definition: GET-ALL-ATTS
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 19.09.2007, 18:39
#26
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Чего-то не фурычит твой лисп. Говори как пользоваться.
Supermax вне форума  
 
Непрочитано 19.09.2007, 18:43
#27
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


И у меня аналогично
Supermax вне форума  
 
Автор темы   Непрочитано 19.09.2007, 18:44
#28
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


2 Кулик Алексей aka kpblc
а здесь
Код:
[Выделить все]
Command:
Command: (try-to-renum)
; error: too few arguments
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 19.09.2007, 18:47
#29
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Гениально Kpblc!
С начала мы все элементы сделанные дин. блоками и имеющие атрибут для номера прочесываем и маркируем редактируя значение этого атрибута. Затем пишем малюсенькую прогу, которая ставит выноски, а значение в них слизывает из значения атрибута того элемента к которому выноска ставиться.
ГЕНИАЛЬНО!
Supermax вне форума  
 
Автор темы   Непрочитано 19.09.2007, 18:55
#30
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


2 Supermax идею насчет привязки позиции к длине элемента, я понял. Получается
длина L1 - позиция N1
длина L2 - позиция N2
длина L3 - позиция N3
.
.
.
длина Ln - позиция Nn
плюс - понятно как!
минус - скажем при градации длин 1мм от 100 до 8000 позиций будет мммммммм вообщем много будет, если на чертеже всего 10-15 типоразмеров и длины весьма отличаются будет что-то так
1586 - поз.1586
2222 - поз. 2222
250 - поз. 250
...

както не катит :?
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 19.09.2007, 18:56
#31
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


В макросе не задана функция get-all-atts.
Supermax вне форума  
 
Автор темы   Непрочитано 19.09.2007, 18:59
#32
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


2 пост 30
ps
хотя идея мне нравится
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Автор темы   Непрочитано 19.09.2007, 19:13
#33
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Объясню для чего мне это надо.
Монтажную схему стоек (ригелей) сейчас приходится делать вручную, проставлять позиции, считать длины, заносить в таблицу. Отсюда велика вероятность ошибки, что неправильно замаркируешь или длину укажешь, или в таблице значения перепутаешь. Приходится долго нудно и кропотливо проверять. А проект как всегда нужен вчера.
Поэтому большое спасибо тем кто откликнулся. [sm140]
Думаю полученная в итоге программа пригодится не только мне.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 19.09.2007, 19:14
#34
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Нет, градации длин должны округляться самим пользователем. Хочешь 1мм а хочешь 10мм, а хочешь и 50мм. С начала задать размер округления, а затем маркируешь. Тоько маркировка начинается всегда с 1, а вот первая длинна может быть какая угодно, но естественно самая маленькая из выбранных для маркировки элементов. К цифре надо и текстик автоматически добавлять. Типа буквочек или целых слов типа "Стойка-1". Текстик этот надо тоже пользователю давать для определения.
Supermax вне форума  
 
Непрочитано 19.09.2007, 19:18
#35
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Да я, дык, теплотрассы динамическими блоками труб развожу и хотя у меня там и есть атрибут "номер позиции" я его пока вообще не заполняю. А тут такая удача. Жаль что Kpblc в Питере, а то бы расцеловал.
Supermax вне форума  
 
Непрочитано 19.09.2007, 19:26
#36
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Kpblc, скажи, что тебе надо? Хочешь объемами проектных работ поделюсь, или увековечу твое имя на всех чертежах что выпускаю?
(денег не дам, и не проси! Самому нужны)
Supermax вне форума  
 
Непрочитано 19.09.2007, 19:56
#37
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Я ж в комментах написал, как пользоваться.
Код:
[Выделить все]
(try-to-renum "dlina" "pos")
- посмотрите внимательнее.
> Supermax : Не очень догнал, чего, получилось?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.09.2007, 20:21
#38
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Я хоть и не видел как работает твой макрос по причине его временной нетрудоспособности, но чисто интуитивно предположил, что ты длины читаешь, сортируешь, нумеруешь и атрибуты блокам правишь.
Может ты чего не так задумал?
И где скажи ты определил функцию get-all-atts? Она в нескольких местах встречается и кад ее хочет! Ты понимаешь, КАД ЕЕ ХОЧЕТ!!!
Supermax вне форума  
 
Непрочитано 19.09.2007, 20:24
#39
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


TRY-TO-RENUM запустил, но он ничего с блоками не сделал. Ни длины не изменил, ни номера не поставил.
Supermax вне форума  
 
Непрочитано 19.09.2007, 20:37
#40
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Что касаемо ригелей, то длинну там вручную ставить нельзя! Это изделие штатное и на заказ его делают только если ОЧЕНЬ припечет.
Поэтому смотрите мой DWG и не длинну тогда надо считывать, а марку изделия. Собственно Kpblc ты не отвлекайся, длинну делай, длинну. Марку потом вставишь. Мне в данный момент длинна важнее.
Считываешь длинну, делишь ее на число, что тебе юзер дал как округление, полученное значение округляешь до целого и полученное значение после умножения на число пользователя, заносишь как настоящее значение длинны этого элемента.
Я бы так делал.
Supermax вне форума  
 
Непрочитано 19.09.2007, 21:12
#41
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Цитата:
Сообщение от Supermax
TRY-TO-RENUM запустил, но он ничего с блоками не сделал. Ни длины не изменил, ни номера не поставил.
Ну е-мое, сколько раз можно говорить, функция имеет 2 обязательных параметра. Первый - тэг атрибута, по которому производится сортировка. Второй - тэг атрибута, в который проставлять позиции. Если в блоке отсутствует хоть что-то из этого, с блоком ничего сделано не будет. Если блок находится на блокированном слое, он исключается из набора. Если атрибут помещен на блокированный слой, его значение не меняется.
Ну что, мне видео сделать, как работает? Я ж проверяю перед опубликованием, а если не проверяю, то предупреждаю об этом.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.09.2007, 21:17
#42
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Ну е калы мыны!
Взял ТВОЙ DWG, где вставлены POZ.
Переписал твой первый макрос в файл .lsp
Загрузил
Вставил в коммандную строку (try-to-renum "dlina" "pos")
нажал ентер
Объвел блоки
нажал ентер

- Какие были свойства и длины такие и остались.
Supermax вне форума  
 
Непрочитано 19.09.2007, 21:20
#43
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


АААААА!!!
Ты вместо POZ написал pos!!!
Исправляй!
Supermax вне форума  
 
Непрочитано 19.09.2007, 21:28
#44
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Ладно, поменял я длинну, опять запустил и все осталось как есть.
Обнулил атрибуты - не помогло. Вернуло те номера, что с самого начала сделала.
Один раз отмаркировало насмерть! Меняй длинну, не меняй теперь уже ничего по новой не отмаркируешь.
Это я изгалясь от скуки.
Вставь очистку памяти от старых значений.
Supermax вне форума  
 
Непрочитано 19.09.2007, 21:30
#45
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Перезагрузил чертеж и макрос - отмаркировало как положено.
Просто перезагрузка макроса не спасает. Чертеж перегружать приходится.
Supermax вне форума  
 
Непрочитано 19.09.2007, 21:58
#46
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Будь добр, возьми мою трубу и откатай на ней макрос.
Не хочет он пробелы видеть в длинне "... L=" без пробела берет.
Русский шрифт ему не нравится. А как без него?

(try-to-renum "... L=" "ПОЗИЦИЯ_ПО_СХЕМЕ") надо чтобы взял!!
Supermax вне форума  
 
Непрочитано 19.09.2007, 22:18
#47
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Без учета #46
Специально только что проверил, нашел один баг / фичу, пофиксил. Суть в том, что не выполнялось преобразование в числовое значение для сортировки. Теперь выполняется, если это возможно. Дополнительно внес в локальные переменные объявления 2 функций.
Код:
[Выделить все]
(defun try-to-renum (source                       res
                     /                            selset
                     adoc                         pos
                     ent_lst                      _kpblc-conv-vla-to-list
                     _kpblc-block-attr-get-pointer-mask
                     _kpblc-is-ent-block-with-attr
                     _kpblc-is-ent-block-with-constant-attr
                     _kpblc-property-get          _kpblc-property-set
                     _kpblc-conv-value-to-string  _kpblc-error-catch
                     _kpblc-error-print
                     )
                    ;|
*    Простановка позиций с повторами для блоков
*    Параметры вызова:
   source   тэг атрибута, критичного к простановке (например, DLINA)
   res   тэг атрибута, куда устанавливается значение позиции
*    Примеры вызова:
(try-to-renum "dlina" "pos")
|;

  (defun _kpblc-conv-value-to-string (value /)
                                     ;|
*    конвертация значения в строку.
|;
    (if value
      (vl-princ-to-string value)
      ""
      ) ;_ end of if
    ) ;_ end of defun

  (defun _kpblc-error-catch (protected-function
                             on-error-function
                             /
                             catch_error_result
                             )
                            ;|
*** Функция взята из книжной версии ruCAD'a без каких бы то ни было переделок,
*** кроме переименования.
*    Оболочка отлова ошибок.
*    Параметры вызова:
*   protected-function   - "защищаемая" функция
*   on-error-function   - функция, выполняемая в случае ошибки
|;
    (setq catch_error_result (vl-catch-all-apply protected-function))
    (if (and (vl-catch-all-error-p catch_error_result)
             on-error-function
             ) ;_ end of and
      (apply on-error-function
             (list (vl-catch-all-error-message catch_error_result))
             ) ;_ end of apply
      catch_error_result
      ) ;_ end of if
    ) ;_ end of defun

  (defun _kpblc-error-print (func-name msg)
                            ;|
*    Функция вывода сообщения об ошибке для (_kpblc-error-catch)
*    Параметры вызова:
*   func-name   имя функции, в которой возникла ошибка
*   msg      сообщение об ошибке
|;
    (princ (strcat "\n ** "
                   (strcase func-name t)
                   " ERROR #"
                   (if msg
                     (strcat
                       (_kpblc-conv-value-to-string (getvar "errno"))
                       ": "
                       (_kpblc-conv-value-to-string msg)
                       ) ;_ end of strcat
                     ": undefined"
                     ) ;_ end of if
                   "\n"
                   ) ;_ end of strcat
           ) ;_ end of princ
    (princ)
    ) ;_ end of defun

  (defun _kpblc-property-set (obj property value / res)
                             ;|
*    Установка значения свойства объекта.
*    Параметры вызова:
*   obj      указатель на объект
*   property   наименование свойства
*   value      устанавливаемое значение
|;
    (_kpblc-error-catch
      (function
        (lambda ()
          (if (and obj
                   (vlax-property-available-p
                     obj
                     property
                     t
                     ) ;_ end of vlax-property-available-p
                   (vlax-read-enabled-p obj)
                   (vlax-write-enabled-p obj)
                   (not (vlax-erased-p obj))
                   ) ;_ end of and
            (progn
              (vlax-put-property
                obj
                property
                (cond
                  ((or (= (type value) (type (vlax-get-property obj property)))
                       (and (member (type value) (list 'int 'real))
                            (member (type (vlax-get-property obj property))
                                    (list 'int 'real)
                                    ) ;_ end of member
                            ) ;_ end of and
                       ) ;_ end of or
                   value
                   )
                  ((and (= (type (vlax-get-property obj property)) 'variant)
                        (member (type (car (_kpblc-conv-vla-to-list value)))
                                (list 'int 'real)
                                ) ;_ end of member
                        ) ;_ end of and
                   (vlax-3d-point (_kpblc-conv-vla-to-list value))
                   )
                  ((= (type (vlax-get-property obj property)) 'variant)
                   ((lambda (/ temp value_type)
                      (setq temp (_kpblc-conv-vla-to-list value))
                      (vlax-make-variant
                        (vlax-safearray-fill
                          (vlax-make-safearray
                            (cond ((= (type (car temp)) 'real) vlax-vbdouble)
                                  ((= (type (car temp)) 'int) vlax-vbinteger)
                                  ((= (type (car temp)) 'str) vlax-vbstring)
                                  (t vlax-vbobject)
                                  ) ;_ end of cond
                            (cons 0 (1- (length temp)))
                            ) ;_ end of vlax-make-safearray
                          temp
                          ) ;_ end of vlax-safearray-fill
                        ) ;_ end of vlax-make-variant
                      ) ;_ end of lambda
                    )
                   )
                  ) ;_ end of cond
                ) ;_ end of vlax-put-property
              ) ;_ end of if
            (setq res (vlax-get-property obj property))
            ) ;_ end of if
          ) ;_ end of lambda
        ) ;_ end of function
      '(lambda (x)
         (_kpblc-error-print
           (strcat
             "_kpblc-property-set :"
             " obj->"
             (_kpblc-conv-value-to-string (_kpblc-property-get obj 'objectname))
             " property->"
             (_kpblc-conv-value-to-string property)
             " value-> "
             (_kpblc-conv-value-to-string value)
             ) ;_ end of strcat
           x
           ) ;_ end of _kpblc-error-print
         ) ;_ end of lambda
      ) ;_ end of _kpblc-error-catch
    res
    ) ;_ end of defun

  (defun _kpblc-property-get (obj property / res)
                             ;|
*    Получение значения свойства объекта
|;
    (_kpblc-error-catch
      (function
        (lambda ()
          (if (and obj
                   (vlax-property-available-p
                     obj
                     property
                     ) ;_ end of vlax-property-available-p
                   ) ;_ end of and
            (setq res (vlax-get-property obj property))
            ) ;_ end of if
          ) ;_ end of lambda
        ) ;_ end of function
      '(lambda (x)
         (_kpblc-error-print
           (strcat "_kpblc-property-get :"
                   " obj->"
                   (_kpblc-conv-value-to-string
                     (if (vlax-property-available-p
                           obj
                           'objectname
                           ) ;_ end of vlax-property-available-p
                       (vla-get-objectname obj)
                       obj
                       ) ;_ end of if
                     ) ;_ end of _kpblc-conv-value-to-string
                   " property->"
                   (_kpblc-conv-value-to-string property)
                   ) ;_ end of strcat
           x
           ) ;_ end of _kpblc-error-print
         ) ;_ end of lambda
      ) ;_ end of _kpblc-error-catch
    res
    ) ;_ end of defun

  (defun _kpblc-is-ent-block-with-attr (ent)
                                       ;|
*    Функция проверяет, является ли переданный указатель блоком и есть ли в нем
* изменяемые атрибуты
*    ent   указатель на проверяемый примитив
|;
    (and
      (= (strcase (vla-get-objectname ent) t) "acdbblockreference")
      (= (_kpblc-property-get ent 'hasattributes) :vlax-true)
      (> (vlax-safearray-get-u-bound
           (vlax-variant-value (vla-getattributes ent))
           1
           ) ;_ end of vlax-safearray-get-u-bound
         -1
         ) ;_ end of >
      ) ;_ end of and
    ) ;_ end of defun

  (defun _kpblc-is-ent-block-with-constant-attr (ent)
                                                ;|
*    Функция проверяет, является ли переданный указатель блоком с постоянными атрибутами
*    Параметры вызова:
*   ent   указатель на вхождение блока
|;
    (and (= (strcase (vla-get-objectname ent) t) "acdbblockreference")
         (vlax-method-applicable-p ent 'getconstantattributes)
         (> (vlax-safearray-get-u-bound
              (vlax-variant-value (vla-getconstantattributes ent))
              1
              ) ;_ end of vlax-safearray-get-u-bound
            -1
            ) ;_ end of >
         ) ;_ end of and
    ) ;_ end of defun

  (defun _kpblc-block-attr-get-pointer-mask (blk mask / res)
                                            ;|
*    Получение списка атрибутов блока по маске. Учитываются также постоянные атрибуты.
*    Параметры вызова:
*   blk   указатель на вставку блока
*   mask   строка с маской тэга атрибута
|;
    (if (_kpblc-is-ent-block-with-attr blk)
      (setq res
             (vl-sort
               (vl-remove-if-not
                 '(lambda (x)
                    (wcmatch (strcase (_kpblc-property-get x 'tagstring))
                             (strcase mask)
                             ) ;_ end of wcmatch
                    ) ;_ end of lambda
                 (vlax-safearray->list (vlax-variant-value (vla-getattributes blk)))
                 ) ;_ end of vl-remove-if-not
               '(lambda (a b)
                  (< (strcase (_kpblc-property-get a 'tagstring))
                     (strcase (_kpblc-property-get b 'tagstring))
                     ) ;_ end of <
                  ) ;_ end of lambda
               ) ;_ end of vl-sort
            ) ;_ end of setq
      ) ;_ end of if
    (if (_kpblc-is-ent-block-with-constant-attr blk)
      (setq
        res
         (append res
                 (vl-sort
                   (vl-remove-if-not
                     '(lambda (x)
                        (wcmatch (strcase (_kpblc-property-get x 'tagstring))
                                 (strcase mask)
                                 ) ;_ end of wcmatch
                        ) ;_ end of lambda
                     (vlax-safearray->list
                       (vlax-variant-value (vla-getconstantattributes blk))
                       ) ;_ end of vlax-safearray->list
                     ) ;_ end of vl-remove-if-not
                   '(lambda (a b)
                      (< (strcase (_kpblc-property-get a 'tagstring))
                         (strcase (_kpblc-property-get b 'tagstring))
                         ) ;_ end of <
                      ) ;_ end of lambda
                   ) ;_ end of vl-sort
                 ) ;_ end of cons
        ) ;_ end of setq
      ) ;_ end of if
    res
    ) ;_ end of defun

  (defun _kpblc-conv-vla-to-list (value / res)
                                 ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (vlax-safearray->list value)
         ) ;_ end of if
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (vl-load-com)
  (if (setq selset (ssget "_:L" '((0 . "INSERT") (66 . 1))))
    (progn
      (foreach ent (setq ent_lst
                          (vl-remove-if-not
                            '(lambda (x)
                               (equal (vla-get-isdynamicblock (car x)) :vlax-true)
                               ) ;_ end of lambda
                            (vl-sort
                              (mapcar
                                '(lambda (a / str)
                                   (cons
                                     (setq a (vlax-ename->vla-object a))
                                     (cond
                                       ((wcmatch
                                          (setq str
                                                 (_kpblc-property-get
                                                   (car
                                                     (_kpblc-block-attr-get-pointer-mask
                                                       a
                                                       source
                                                       ) ; _ end of
                                                     ) ;_ end of car
                                                   'textstring
                                                   ) ; _ end of
                                                ) ;_ end of setq
                                          (strcat (_kpblc-conv-value-to-string (atof str))
                                                  "*"
                                                  ) ;_ end of strcat
                                          ) ;_ end of wcmatch
                                        (atof str)
                                        )
                                       (t str)
                                       ) ;_ end of cond
                                     ) ;_ end of cons
                                   ) ;_ end of lambda
                                (vl-remove-if
                                  'listp
                                  (mapcar 'cadr (ssnamex selset))
                                  ) ;_ end of vl-remove-if
                                ) ;_ end of mapcar
                              (function
                                (lambda (a b)
                                  (cond
                                    ((= (type (cdr a)) (type (cdr b)))
                                     (< (cdr a) (cdr b))
                                     )
                                    (t
                                     (< (_kpblc-conv-value-to-string (cdr a))
                                        (_kpblc-conv-value-to-string (cdr b))
                                        ) ;_ end of <
                                     )
                                    ) ;_ end of cond
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              ) ;_ end of vl-sort
                            ) ;_ end of vl-remove-if-not
                         ) ;_ end of setq
        (_kpblc-property-set
          (car (_kpblc-block-attr-get-pointer-mask (car ent) res))
          'textstring
          (_kpblc-conv-value-to-string
            (setq
              pos (cond
                    ((= (length ent_lst) (length (member ent ent_lst)))
                     1
                     )
                    (t
                     (if (= (cdr ent)
                            (cdr (nth (1- (- (length ent_lst)
                                             (length (member ent ent_lst))
                                             ) ;_ end of -
                                          ) ;_ end of 1+
                                      ent_lst
                                      ) ;_ end of nth
                                 ) ;_ end of cdr
                            ) ;_ end of =
                       pos
                       (setq pos (1+ pos))
                       ) ;_ end of if
                     )
                    ) ;_ end of cond
              ) ;_ end of setq
            ) ;_ end of _kpblc-conv-value-to-string
          ) ;_ end of _kpblc-property-set
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
Файл, на котором выполнялось тестирование - аттач. Среда тестирования: ADT 2006 RUS + SP1, запущен как ACAD. Видео не делал.
[ATTACH]1190225934.dwg[/ATTACH]
Примеры вызова:
(try-to-renum "name" "pos")
(try-to-renum "dlina" "pos")
---
Добавлено: какая труба? Откуда ее взять-то? Выкладывай.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.09.2007, 22:19
#48
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Ура-а-а-а! Я трубу починил и все заработало даже с русским шрифтом.
Пробел пришлось ликвидировать, атрибуты снести и поновой вставить, там еще один комплект висел непонятно где. Только полной видимостью и нашел.

Так, не расслабляться! Округление человеческое давай и добавочку к номеру.
Supermax вне форума  
 
Непрочитано 19.09.2007, 22:24
#49
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Первый вариант на моей трубе работает, а второй не хочет!.
Да и первый маркирует все блоки номером 1
Supermax вне форума  
 
Непрочитано 19.09.2007, 22:25
#50
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Цитата:
Сообщение от Supermax
Будь добр, возьми мою трубу и откатай на ней макрос.
Не хочет он пробелы видеть в длинне "... L=" без пробела берет.
Русский шрифт ему не нравится. А как без него?

(try-to-renum "... L=" "ПОЗИЦИЯ_ПО_СХЕМЕ") надо чтобы взял!!
А у тебя что, тэги такие у атрибутов? Во второй еще могу попробовать поверить, но вот в первый - никогда.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.09.2007, 22:28
#51
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Цитата:
Сообщение от Supermax
Первый вариант на моей трубе работает, а второй не хочет!.
Вот блин... У меня дома 3 нокии (разных моделей, разных, не надо! ) и 1 гнусмас, не считая труб в санузле. Твоей трубы у меня нет. Проверить не смогу пока не дашь.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.09.2007, 22:34
#52
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


На.
[ATTACH]1190226898.dwg[/ATTACH]
Supermax вне форума  
 
Непрочитано 19.09.2007, 22:36
#53
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Все, ушел домой. Завтра продолжу.
Supermax вне форума  
 
Непрочитано 19.09.2007, 23:00
#54
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Прошу прощения что позновато влезаю, но есть и вариант сделать это без лиспа - с помощью контрольной суммы, минус в том, что вхождения блоков не будут упорядоченны по номеру относительно длинны, а вероятность колиизии определяеться размерностью (должно быть достаточно большое простое число относительно количества вхождений) - объяснение муторое получилось - смотри пример если подойдет то пожалуйста.
[ATTACH]1190228400.dwg[/ATTACH]
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 19.09.2007, 23:36
#55
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


> Supermax : Бгы... Ессно, работать не будет. Потому что у меня идет обращение к атрибутам блока, а не к значениям динамических свойств. Отсюда мораль - еще раз внимательно перечитывать тему
Лично мне сейчас переделывать лисп в ломак по полной программе. Потому что следом захочется ставить позиции на основе не одного свойства, а нескольких, да еще и в порядке указания, да еще и с возможностью фильтрации по атрибутам... Не, народ, я на такое не согласный.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 20.09.2007, 09:32
#56
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Дорогой наш Кулик Алексей aka kpblc работает!!!!!!!!!!!!!!!!!!!!!
я из первого поста запустил РАБОТАЕТ именно так как надо
Смотри прилагаемый чертеж
[ATTACH]1190266169.dwg[/ATTACH]
Порядок моих действий
1 - расстановка стоек
2 - Regenall
3 - Ввод команды
Код:
[Выделить все]
(try-to-renum "dlina" "pos")
где заместо "dlina" "pos" вставляю теги длины и позиции (у меня "dlina" "poz")
4 - и собственно на обсчет
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 20.09.2007, 09:41
#57
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Сначала чутка оффтопа:
Я сейчас не работает, я сейчас сидит дома и слегка болеет и с трудом соображает.
Теперь серьезно: вариант будет корректно работать, пока длина стоек не будет составлять, к примеру, такую последовательность: 150 200 2000 78 - вот тогда нумерация позиций корректно проставлена не будет. В последнем варианте я попробовал уйти от этого. Вроде даже получилось.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.09.2007, 09:44
#58
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


> zenon №25
Подправил код в посте № 21. Если еще актуально, то должно работать
VVA вне форума  
 
Автор темы   Непрочитано 20.09.2007, 09:48
#59
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


2 вариант тоже работает, я как-то разницы не заметил.

Цитата:
Сообщение от Кулик Алексей aka kpblc
Я сейчас не работает, я сейчас сидит дома и слегка болеет и с трудом соображает.
Горячий чай с малиной!!!

Цитата:
Сообщение от Кулик Алексей aka kpblc
Теперь серьезно: вариант будет корректно работать, пока длина стоек не будет составлять, к примеру, такую последовательность: 150 200 2000 78 - вот тогда нумерация позиций корректно проставлена не будет. В последнем варианте я попробовал уйти от этого. Вроде даже получилось.
Попробовал вроде работет. А в чем баг был??
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 20.09.2007, 10:48
#60
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Для примеру: выбрать 4 стойки, в первой длина 700, во второй - 78, в третьей - 470, в последней - 5600. Какова должна быть последовательность позиций и какова она будет (при первом варианте)?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 20.09.2007, 10:53
#61
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Цитата:
Сообщение от Кулик Алексей aka kpblc
Для примеру: выбрать 4 стойки, в первой длина 700, во второй - 78, в третьей - 470, в последней - 5600. Какова должна быть последовательность позиций и какова она будет (при первом варианте)?
я думал длины сортируются, по быванию или возрастанию
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Автор темы   Непрочитано 20.09.2007, 10:56
#62
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Цитата:
Сообщение от VVA
> zenon №25
Подправил код в посте № 21. Если еще актуально, то должно работать
Счас работает
Если можно то добавь фунцию выбора, а то не всегда нужно проставлять на всем чертеже
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 20.09.2007, 12:50
#63
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Цитата:
Сообщение от zenon
Цитата:
Сообщение от Кулик Алексей aka kpblc
Для примеру: выбрать 4 стойки, в первой длина 700, во второй - 78, в третьей - 470, в последней - 5600. Какова должна быть последовательность позиций и какова она будет (при первом варианте)?
я думал длины сортируются, по быванию или возрастанию
Изначально они сортировались как строки, в последнем моем варианте - как числа, если это возможно.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 20.09.2007, 12:59
#64
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Пока все работает, попозже выскажу некоторые хотелки.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 20.09.2007, 14:19
#65
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от zenon
Цитата:
Сообщение от VVA
> zenon №25
Подправил код в посте № 21. Если еще актуально, то должно работать
Счас работает
Если можно то добавь фунцию выбора, а то не всегда нужно проставлять на всем чертеже
См. пост №21
VVA вне форума  
 
Автор темы   Непрочитано 20.09.2007, 14:40
#66
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


2 VVA
зер гуд
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 20.09.2007, 16:30
#67
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


VVA, редактирование длин и повторный запуск твоего макроса не производят исправлений. Надо очищать старые показания.
Supermax вне форума  
 
Непрочитано 20.09.2007, 16:41
#68
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


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

А за деньги готовы макрос до ума довести? Могу дать 3000р.
За больше и сам могу написать.
Supermax вне форума  
 
Автор темы   Непрочитано 20.09.2007, 17:00
#69
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Цитата:
Сообщение от Supermax
VVA, редактирование длин и повторный запуск твоего макроса не производят исправлений. Надо очищать старые показания.
У меня все считает
Цитата:
Сообщение от Supermax
Короче, тема сдулась. Если при написании макросов будет такой подход, мол дескать под конкретные квадратики с кружечками, да и то только если заказчик постоянно теребит, то жалко, жалко ваш труд господа.
А за деньги готовы макрос до ума довести? Могу дать 3000р.
За больше и сам могу написать.
Не слушайте его!!!!!!!

По моему вопросу все правильно и корректно работает.
Остались небольшие косметические доработки. Вот освобожусь потестю и выдам последние пожелания.

2 Supermax ох и вредный ты мужик :evil:
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 20.09.2007, 17:02
#70
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
VVA, редактирование длин и повторный запуск твоего макроса не производят исправлений. Надо очищать старые показания
Пробуй теперь с поста №21
Цитата:
А за деньги готовы макрос до ума довести? Могу дать 3000р
Поставь полное ТЗ и если в результате макрос не раздуется до СПДС GraphiCS то почему бы и нет [/quote]
VVA вне форума  
 
Автор темы   Непрочитано 20.09.2007, 17:16
#71
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


2 VVA у него кад не той системы
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 20.09.2007, 18:22
#72
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


В титрах пишет правильно, а атрибуты на ваших квадратиках не правит. Про мои трубы пока молчу, я там и двумя атрибутами пожертвовал, и свойство как у вас сделал (оно у меня было ... L=).

Про ТЗ, собственно мне тоже надо, чтобы мои трубы хавал (пардон за выражение). Kpblc правильный подход дал, только не доделал чуток. (функция "признак А" "размер округления" "название свойства длинны" "название атрибута для установки округленной длинны" "название атрибута для номера") это если с длинами, если с именами, то (функция "признак Б" "название свойства с именем или маркой" "название атрибута для номера") признаки для отличия одного режима работы от другого. Можно конечно и слить, но очень длинно получится тогда третий признак - все выше перечисленные исходные данные.
Можно, и даже нужно не строчечное а диалоговое заполнение данных.
[ATTACH]1190298174.dwg[/ATTACH]
Supermax вне форума  
 
Непрочитано 20.09.2007, 18:39
#73
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


И чего это я вредный? Сижу, тестю ваши квадратики, свои любимые трубы уродую английскими буквами, трачу свое драгоценное время (знал бы мой заказчик чем я занимаюсь вместо его заказа), а меня зачисляют в команду рогатой нечисти. Лучше бы сделали ваши стойки в 3D со всеми полезными данными о них. Я бы вам помог их задинамичить, вот это была бы работа. Зрение свое тратишь на всякое баловство.
Извиняйся давай! А то я обижусь. :cry:
Supermax вне форума  
 
Непрочитано 20.09.2007, 19:03
#74
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


И еще про округление длин.
Вот у меня монтажка, сделанная динблоками. Округлять всегда надо в плюс максимум 50мм. Поясню: Трубу всегда можно немного подрезать. Даже очень много можно, вместе с изоляцией. Заказывать трубы надо всегда в плюс иначе будет не хорошо. Стыки изолировать можно только до определенной длинны, если не хватает длинны приходится по месту вставлять метровые отрезки (это разрешенный минимум). И вот представьте, последний стык и не хватает пол метра (набежало). Что делать? нужен кусок трубы 1м. а его нет. и купите на Мосфлоулайн 1 метр, попробуйте. Вы его до-о-лго будете ждать. Ради одного метра там, да и не только, париться не будут. Запас всегда нужен, но если у вас останется после монтажа две трубы по 12 метров - вам их выдадут вместо зарплаты. Да и то не за один месяц, а за несколько.
Резюме - округление надо закладывать либо +/-, либо только +.
Supermax вне форума  
 
Непрочитано 20.09.2007, 19:28
#75
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


2Supermax
Надоело твое нытье. Бери книжку в руки и дорабатывай под себя код открытый выложили наши ГОРЯЧО ЛЮБИМЫЕ ПРОГРАММИСТЫ!!! СПАСИБО!!!
2Дима_
Прикольное решение, только неподсилу моим мозгам:
1) раскажи плз что такое trunc в филдах (первый раз узрел).
2) я с математикой не очень в ладах, поэтому без кратких пояснений несколько лет буду допирать.
Заранее благодарен.
ЗЫ: kpblc & VVA еще раз огромное спасибо!!!
Sleekka вне форума  
 
Непрочитано 20.09.2007, 19:35
#76
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Supermax №72

Цитата:
В титрах пишет правильно, а атрибуты на ваших квадратиках не правит. Про мои трубы пока молчу, я там и двумя атрибутами пожертвовал, и свойство как у вас сделал (оно у меня было ... L=).
Не все
У тебя атрибут имеет тэг POS, у меня POZ
Найди этот кусок в программе
Код:
[Выделить все]
;;;====================== MAIN PART ============================ 
;;;============================================================= 
  
  (setq bname "Stoyka") ;_Имя блока 
  (setq atname "Dlina") ;_Имя аттрибута откуда брать 
  (setq attTo "Poz") ;_Имя аттрибута куда вбивать
И вместо (setq attTo "Poz") вбей (setq attTo "Pos")
Глядишь, и квадратики начнут правится
VVA вне форума  
 
Непрочитано 20.09.2007, 19:44
#77
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Kpblc может подтвердить, если я сяду калупать эти коды, я их так уделаю, что у тебя не три, тридцать три вопроса возникнут, но работать они будут как часы по всем параметрам и на любых файлах.
Если я тут свои коды не кладу, так это только потому, что меня опередил Kpblc. Он меня сюда затащил.

VVA.
Я и POZ и POS пробовал, что я не понимаю. Надо договориться сразу POZ, так POZ.
Supermax вне форума  
 
Непрочитано 20.09.2007, 19:48
#78
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Supermax
С pos на твоем чертеже у меня все отработало. Правда пересохранил его для 2006, но это повлиять не должно. Завтра еще раз проверю в 2007/2008
VVA вне форума  
 
Непрочитано 20.09.2007, 20:01
#79
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Сижу в 2008-ом.
выдает
Command: (c:NDB)
Select objects: Specify opposite corner: 3 found
Select objects:
_.UPDATEFIELD
Select objects: 1 found
Select objects: 1 found, 2 total
Select objects: 1 found, 3 total
Select objects:
0 field(s) found.
0 field(s) updated.
Command:
Позиция Длинна
1 - 0.0

и усе. Дальше не хочет.
Я трубы в Stoyka переименовал и POZ и DLINA вставил - пока не хочет зараза.
Supermax вне форума  
 
Непрочитано 20.09.2007, 20:04
#80
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


С квадратиками справляется, а с трубами пока не хочет.
Supermax вне форума  
 
Непрочитано 20.09.2007, 20:19
#81
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Так, установлен следующий факт, если в атрибутах "DLINA" вручную прописать длины, то он эти длины посчитает и атрибут "POZ" промаркирует. Это у меня в трубах. Из свойства "Distance" значение в атрибут "DLINA" не переходит.
Supermax вне форума  
 
Автор темы   Непрочитано 20.09.2007, 20:28
#82
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Вообщем еще 2 пожелания осталось
1 - ввести команду _regen перед началом работы основной программы.
2 - Добавить возможность вставки префикса и суффикса в позицию.
В остальном программы вполне рабочие.
ps Kpblc а может ввести указание пользователем тега атрибутов длины и позиции, чтоб мышкой тнул и в атрибут (типа 1 - укажите аттрибут длины, 2 - укажите атрибут позиции)???
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 20.09.2007, 20:28
#83
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


2Supermax #81
прочитай страницу N1 этого топика, если не поможет читай еще раз и так далее пока не дойдет.
Sleekka вне форума  
 
Непрочитано 20.09.2007, 21:26
#84
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Вот тут возник у меня один вопросик.
Нумерация что только у стоек, или еще есть элементы с номерами?
Если есть еще елементы, то что, у них имя блока тоже Stoyka?
Вот я взял и подредактировал bname.
(= (strcase name)(strcase name)) извините за наглость и лень круто все менять.
Теперь у меня сквозняком все блоки нумеруются, а не только StoyK-и.
Если бы нумерация была "Ст-1", "Ст-2" и т.д. я бы понял, что другие элементы к этим "Ст-" не относятся, а так, голые цифры - непонятно, что дальше делать будете. Или у тех элементов не кружочки, а ромбики, квадратики и т.д.? Или у вас на чертеже кроме стоек нет ничего?

P.S. Sleekka а ты кроме как читать чего-нибудь умеешь?
Supermax вне форума  
 
Непрочитано 20.09.2007, 21:42
#85
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Значит так, попытаюсь разобраться:
Прежде всего, №81 : если атрибуту назначить поле, которое будет брать длину с объекта, то ничего проставлять руками не надо. zenon все отлично показал, даже у меня получилось разобраться. Учитывая, что у Supermax 2007 или 2008, ситуация упрощается - лично у меня не удалость в 2006 взять значения прямо с динамического свойства (хотя и не отрицаю такую возможность). А так... Сделать атрибут невидимым, в него поле и(или) формулу и всех делов. Забирай
> №72 : Я ж говорил... А сейчас я задаю достаточно каверзный вопрос: что делать, если в блоке атрибут1, свойство1 и свойство2 одинаковы, но разница в свойстве34? А что делать, если в выбранном блоке отсутствует атрибут, куда вставлять позицию? А что делать...
Для конкретных труб выполнить задачу "взять длину, тип материала, диаметр; длину округлить с шагом 100 вверх и проставить позицию в атрибут с тэгом PositionForSpecification" вполне выполнима. Но это тоже будет конкретное решение конкретной задачи.
> #82 : ну у меня регенерация после выполнения происходит (правда, только после успешного). Префикс и суффикс можно и тут сделать, можно и воспользоваться готовыми решениями (варианты выкладывались и здесь, и на autocad.ru - найти только надо).
> PS: можно, но явно не сегодня. Завтра, и то, если VVA не опередит
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.09.2007, 22:06
#86
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


2Slekka ну в кратце так - контрольная сумма - функция которая дает уникальное число определенной разрядности к набору данных - в основном служит для проверки, в моем случае используется остаток длинны от 23 (делим длинну на 23 остаток и есть контрольная сумма) - то есть варианты могут быть от 0 до 22, почему 23 - это простое число (делится только на себя и единицу) соответственно вероятность совпадения равна 1/23. То есть моя функция на 23, 46, 460 - выдаст одно и тоже число - 0 - это и есть коллизия. Чтобы уменьшить вероятность коллизии надо взять большее простое число, но и разброс будет больше - число следует подбирать по прикидкам кокое количество групп может максимально использоваься. Про trunc - это округление до целого в меньшую сторону - делим на 23 округляем в меньшую, умножаем на 23 - разница и есть остаток. В общем как-то так. Если непонятно спрашивай. :wink:
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 20.09.2007, 22:24
#87
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


2Дима_
Все теперь стало понятно, спасибо
Остался еще 2 вопроса
1)откуда ты узнал про trunc (неужели arx формулы декомпилировал)?
2) может там еще чего такого полезного есть?
Sleekka вне форума  
 
Непрочитано 20.09.2007, 22:55
#88
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Взято из хелпа 2006:
sin(угол)
Синус угла

cos(угол)
Косинус угла

tang(угол)
Тангенс угла

asin(вещ)
Арксинус числа. Аргумент должен лежать в пределах от –1 до 1

acos(вещ)
Арккосинус числа. Аргумент должен лежать в пределах от –1 до 1

atan(вещ)
Арктангенс числа

ln(вещ)
Натуральный логарифм числа

log(вещ)
Десятичный логарифм числа

exp(вещ)
Натуральная экспонента числа

exp10(вещ)
Десятичная экспонента числа

sqr(вещ)
Квадрат числа

sqrt(вещ)
Квадратный корень числа (неотрицательного)

abs(вещ)
Абсолютная величина числа

round(вещ)
Число, округленное до ближайшего целого

trunc(вещ)
Целая часть числа

r2d(угол)
Преобразование угла из радиан в градусы. Например, r2d(pi) преобразует pi радиан в 180 градусов

d2r(угол)
Преобразование угла из градусов в радианы. Например, d2r(180) преобразует угол 180 градусов в радианы и возвращает значение, равное константе pi

pi
Константа «пи»

Вообще в акаде много интересного, но никак не могу придумать импорт данных в параметры, сам Крыс сказал что дело гиблое, а тут как говорится возразить нечего.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 20.09.2007, 23:12
#89
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Мало ли что крыс сказал, я не бог. По слухам (но не помню где мелькнуло), вроде были попытки сделать полностью программное создание дин.блока на лиспе, но результата истории я не знаю - не следил. Очевидно, что надо расковыривать динамический блок , созданный самостоятельно (и словари и РД, с ним связанные). Меня на это не хватило
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.09.2007, 23:15
#90
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


2Крыс - скажи честно у тебя на твой Ник "звоночек" стоит? :?:
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 20.09.2007, 23:54
#91
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Да не, TelepatApplication наконец хоть как-то заработал, но коннектится только на общедоступные адреса, к пользователям - ну ни в какую, хоть тресни Connection timeout, User have a rest или еще чем-то таким же непотребным матерится.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 21.09.2007, 09:16
#92
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,439
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Дима_
Взято из хелпа 2006:
sin(угол)
Синус угла

cos(угол)
Косинус угла

tang(угол)
Тангенс угла

asin(вещ)
Арксинус числа. Аргумент должен лежать в пределах от –1 до 1

acos(вещ)
Арккосинус числа. Аргумент должен лежать в пределах от –1 до 1

atan(вещ)
Арктангенс числа

ln(вещ)
Натуральный логарифм числа

log(вещ)
Десятичный логарифм числа

exp(вещ)
Натуральная экспонента числа

exp10(вещ)
Десятичная экспонента числа

sqr(вещ)
Квадрат числа

sqrt(вещ)
Квадратный корень числа (неотрицательного)

abs(вещ)
Абсолютная величина числа

round(вещ)
Число, округленное до ближайшего целого

trunc(вещ)
Целая часть числа

r2d(угол)
Преобразование угла из радиан в градусы. Например, r2d(pi) преобразует pi радиан в 180 градусов

d2r(угол)
Преобразование угла из градусов в радианы. Например, d2r(180) преобразует угол 180 градусов в радианы и возвращает значение, равное константе pi

pi
Константа «пи»

Вообще в акаде много интересного, но никак не могу придумать импорт данных в параметры, сам Крыс сказал что дело гиблое, а тут как говорится возразить нечего.
А можно ли по подробнее, о каком автокаде идет речь, о каком хелпе и каких программах...
Дело в том, что я первый раз слышу, что автокад, без дополнительных программ, знает функции:
Код:
[Выделить все]
tang(угол) 
Тангенс угла 

asin(вещ) 
Арксинус числа. Аргумент должен лежать в пределах от –1 до 1 

acos(вещ) 
Арккосинус числа. Аргумент должен лежать в пределах от –1 до 1 

ln(вещ) 
Натуральный логарифм числа 

exp10(вещ) 
Десятичная экспонента числа 

sqr(вещ) 
Квадрат числа 

round(вещ) 
Число, округленное до ближайшего целого 

trunc(вещ) 
Целая часть числа 

r2d(угол) 
Преобразование угла из радиан в градусы. Например, r2d(pi) преобразует pi радиан в 180 градусов 

d2r(угол) 
Преобразование угла из градусов в радианы. Например, d2r(180) преобразует угол 180 градусов в радианы и возвращает значение, равное константе pi
PS. Конечно, сделать их на лиспе или любом другом языке, не проблема, но хотелось бы ясности...
Елпанов Евгений вне форума  
 
Непрочитано 21.09.2007, 09:44
#93
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Елпанов Евгений Присоединяюсь, ткните на первый раз пальцем (во второй раз придется фэйсом) , где этот trunc прописан. Что-то я в редакторе блока его не нашел
VVA вне форума  
 
Непрочитано 21.09.2007, 09:54
#94
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


No problem:
[ATTACH]1190354040.JPG[/ATTACH]
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 21.09.2007, 09:58
#95
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


сложно найти черную кошку в темной комнате...
[ATTACH]1190354300.dwg[/ATTACH]
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 21.09.2007, 10:05
#96
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,439
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Дима_
No problem:
[ATTACH]1190354040.JPG[/ATTACH]
Спасибо за ответ!
Видимо, я не верно вас понял - вы имели в виду, именно автокадовскую справку, с командами автокада..
Т.е. вы дали список функций, для акадовского калькулятора. А я их искал, хотя был уверен, что их нет, в лисп редакторе...
Елпанов Евгений вне форума  
 
Непрочитано 21.09.2007, 12:25
#97
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от zenon
Вообщем еще 2 пожелания осталось
1 - ввести команду _regen перед началом работы основной программы.
2 - Добавить возможность вставки префикса и суффикса в позицию.
В остальном программы вполне рабочие.
Внес исправления в VVA №21

>Supermax
Вот твой файл, с которым работает лисп из поста 21
[ATTACH]1190363101.dwg[/ATTACH]
VVA вне форума  
 
Непрочитано 21.09.2007, 12:54
#98
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


В 12:45 по Москве обновил пост 21 (устранена одна ошибочка)

Цитата:
а может ввести указание пользователем тега атрибутов длины и позиции, чтоб мышкой тнул и в атрибут (типа 1 - укажите аттрибут длины, 2 - укажите атрибут позиции)???
Пробуй вариант
Код:
[Выделить все]
(defun c:NDB1 ( / adoc ss res name bname atname lst lstLen att poz attTo 
               mip-block-setattr-bylist 
              mip-put-hyperlink 
              mip_MakeUniqueMembersOfList 
              member-i 
              get-all-atts 
              mip-conv-to-str
              *error*
              get-block-name
              )
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
 (vl-load-com)   
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
;; obj - Ename or Vla object of block 
;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...) 
;;                 Tag_Name - string 
;;                    Value - string 
(defun *error* (msg)(princ msg)(vla-EndUndoMark adoc))
(defun mip-block-setattr-bylist (obj att_list / txt lst) 
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj))) 
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list)) 
  (if (and obj 
           (not(vlax-erased-p obj)) 
           (= (vla-get-ObjectName obj) "AcDbBlockReference") 
      (eq :vlax-true (vla-get-HasAttributes obj)) 
      (vlax-property-available-p obj 'Hasattributes) 
      (vlax-write-enabled-p obj) 
      ) 
    (vl-catch-all-apply 
      (function 
   (lambda   () 
          (foreach at (vlax-invoke obj 'Getattributes) 
            (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list)) 
              (vla-put-TextString at (cdr lst)) 
            ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  )
(defun get-block-name ( blk)
  (cond 
                     ((and (vlax-property-available-p blk 'isdynamicblock) 
                           (= (vla-get-isdynamicblock blk) :vlax-true) 
                           ) ;_ end of and 
                      (vla-get-effectivename blk) 
                      ) 
                     (t (vla-get-name blk)) 
                     ) ;_ end of cond 
  )
(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 mip-put-hyperlink (ENAME URLDescription) 
  (if (eq (type ENAME) 'ENAME) 
    (setq ENAME (vlax-ename->vla-object ENAME)) 
  ) ;_ end of if 
  (vlax-for hyp (vla-get-hyperlinks ENAME) (vla-delete hyp)) 
  (vla-add (vla-get-hyperlinks ENAME) 
           "about:blank" 
           URLDescription 
  ) ;_ end of vla-add 
) ;_ end of DEFUN 

;;;Удаляет одинаковые (дубликаты) элементы из списка 
;;;(defun mip_MakeUniqueMembersOfList  ( lst / OutList head) 
;;;  (while lst 
;;;    (setq head (car lst) 
;;;          lst (vl-remove head lst) 
;;;          OutList (append OutList (list head)))) 
;;;  OutList 
;;;  ) 
(defun mip_MakeUniqueMembersOfList  ( lst / OutList head) 
  (while lst 
    (setq head (car lst) 
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6)) lst) 
          OutList (append OutList (list head)))) 
  OutList 
  ) 
(defun member-i ( lst num / i) 
 (setq i 0)(while (and lst (not(equal (car lst) num 1e-6))) 
    (setq i (1+ i) lst(cdr lst))) 
  (if (equal (car lst) num 1e-6) i nil)) 
  (defun get-all-atts (obj) 

  (if (and obj 
      (eq :vlax-true (vla-get-HasAttributes obj)) 
      (vlax-property-available-p obj 'Hasattributes) 
       
      ) 
    (vl-catch-all-apply 
      (function 
   (lambda   () 
     (mapcar (function (lambda (x) 
               (cons (vla-get-TagString x) 
                (vla-get-TextString x) 
               ) 
             ) 
        ) 
        (append (vlax-invoke obj 'Getattributes) 
           (vlax-invoke obj 'Getconstantattributes) 
        ) 
     ) 
   ) 
      ) 
    ) 
  ) 
) 
;;;============================================================= 
;;;====================== MAIN PART ============================ 
;;;============================================================= 
  (vla-StartUndoMark adoc)
  (and
  (setq ss (car(nentsel "Укажите атрибут, откуда брать длинну :")))
  (if (= (cdr(assoc 0 (entget ss))) "ATTRIB")
    (setq atname (cdr(assoc 2 (entget ss))));_Имя аттрибута откуда брать
    (progn(alert "Это не атрибут") nil))
  (setq poz (car(nentsel "Укажите атрибут, куда писать результат :")))
  (if (= (cdr(assoc 0 (entget poz))) "ATTRIB")
    (setq attTo (cdr(assoc 2 (entget poz))));_Имя аттрибута куда вбивать
    (progn(alert "Это не атрибут") nil))
  (or
    (= (setq bname(strcase(get-block-name (vla-ObjectIDToObject adoc (vla-get-OwnerID (vlax-ename->vla-object ss))))));_Имя блока
       (strcase(get-block-name (vla-ObjectIDToObject adoc (vla-get-OwnerID (vlax-ename->vla-object poz)))))
       )
    (alert "\nАтрибуты должны входить в один блок")
    )
  (setq *PREF* (mip-conv-to-str *PREF*))
  (setq *SUFF* (mip-conv-to-str *SUFF*))
  (princ "\nВведите префикс или Пробел - нет <")(princ *PREF*)(princ ">: ")
  (setq *PREF* (getstring t))
  (princ "\nВведите суффикс или Пробел - нет :")(princ *SUFF*)(princ ">: ")
  (setq *SUFF* (getstring t))
  (if (= *PREF* " ")(setq *PREF* "") t)(if (= *SUFF* " ")(setq *SUFF* "") t)         
  (if (and (setq ss (ssget  '((0 . "INSERT")(66 . 1))))
           (setq lstLen (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
           )
    (progn
      (vla-regen adoc acactiveviewport)    
      (foreach blk 
               (mapcar 'vlax-ename->vla-object lstlen) ;_ end of mapcar 
        (setq name (get-block-name blk)) ;_ end of setq 
        (if (= (strcase name)(strcase bname)) 
          (setq lst (cons blk lst))) 
         ;_ end of if 
        ) ;_ end of foreach 
      (setq lstLen (mapcar '(lambda(x)(cdr(assoc (strcase atname)(get-all-atts x)))) lst)) 
      (setq lstLen (mapcar 'atof(vl-remove-if 'null lstLen)))
      (setq lstLen (mip_MakeUniqueMembersOfList lstLen)) 
      (setq lstLen (vl-sort lstLen '(lambda(a b)(< a b)))) 
      (princ "\n Позиция  Длинна")(setq poz 1) 
      (foreach blk lstlen 
        (princ "\n")(princ poz)(princ "  -  ")(princ blk) 
        (setq poz (1+ poz)) 
        ) 
      (foreach blk lst 
        (if (and 
              (setq att(cdr(assoc (strcase atname)(get-all-atts blk)))) 
              (setq att (atof att)) 
              (setq poz (member-i lstlen att)) 
              ) 
          (progn 
            ;_Маркиреум 
            (mip-put-hyperlink blk (itoa(1+ poz))) 
            (mip-block-setattr-bylist blk
              (list (cons (strcase attTo)(strcat *PREF* (itoa(1+ poz)) *SUFF*)))) 
            ) 
          ) 
        )
      t
      ) ;_ end of progn 
    ) ;_ end of if
  )
  (vla-EndUndoMark adoc)
  (princ) 
  )
VVA вне форума  
 
Непрочитано 21.09.2007, 13:00
#99
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


VVA, Мой файл в 72 посте. Да и то, только верхняя его часть. А это, так, ваше в моей интерпритации. Мне оно без надобности.
Дублировать длинну в свойствах длинной в атрибутах считаю ошибкой. Надо округлять и редактировать свойсво. Блоки дернуться и подравняются. Заодно и *Unnn тоже подравняются. Нахлесты и недостача станут видны, это тоже плюс.
VVA, я с тобою не прощаюсь, а всем остальным машу ручкой.
Это последнее мое сообщение в этой теме.
Можете не язвить, из "Избранное" я эту тему уже снес.
Supermax вне форума  
 
Автор темы   Непрочитано 21.09.2007, 17:43
#100
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


2 VVA небольшой вопрос? а что там за гиперссылка вываливается?? когда к блоку подводишь курсор?????
[ATTACH]1190382191.jpg[/ATTACH]
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Автор темы   Непрочитано 21.09.2007, 17:48
#101
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


РАБОТАЕТ СУПЕР!
Большое спасибо от всех фасадчиков, будем запускать в оборот.

ps а коды изи поста 21 и 98 чем нить отличаются???
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 21.09.2007, 23:07
#102
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


Спасибо Дима_.
Кто бы мог подумать что формулы из кадовского калькулятора работают в филдах, а я из-за этого столько мучался. Автодеск - уроды - не могли задокументировать это как следует.
Sleekka вне форума  
 
Непрочитано 24.09.2007, 09:48
#103
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>zenon 100
Это номер позиции, помимо атрибута заносится в hyperlink.
Если раздражает, найди строчку
Код:
[Выделить все]
(mip-put-hyperlink blk (itoa(1+ poz)))
и поставь перед ней ;.
Цитата:
ps а коды изи поста 21 и 98 чем нить отличаются???
Ничем кроме способа выбора атрибута откуда и атрибута куда.

Кстати, я согласен с Supermax в том, что для считывания длины незачем свойство Distanse переносить в атрибут Dlina. Из лиспа оно отлично читается и заносится (можно и "подравнять" блоки) В теперешнем виде стойки с длиннами 370,567 и 370,1 будут иметь разные номера позиций

Последний раз редактировалось VVA, 19.09.2015 в 06:59. Причина: орфография
VVA вне форума  
 
Автор темы   Непрочитано 24.09.2007, 11:46
#104
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Просто мне нужен аттрибут длины для внесения в таблицу, есть программка которая все переносит в табличку.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 24.09.2007, 12:03
#105
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


В принципе разницы никакой - забирать данные из атрибута или динамического свойства.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 24.09.2007, 13:25
#106
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Цитата:
Сообщение от Кулик Алексей aka kpblc
В принципе разницы никакой - забирать данные из атрибута или динамического свойства.
А как быть с таким вариантом :?:
[ATTACH]1190625606.gif[/ATTACH]Каждый раз переписывать код, или дополнительно вводить обрабоку длины, ну так мы дойдем до полноценной программы расчета фасадов. :roll:
Притом никогда не знаешь какое удлинение будет.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 24.09.2007, 14:08
#107
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Хм. А что мешает "по схеме" делать "как в жизни", особенно если фасады не гнутохитрые? Про зимние сады и крыши специально не заикаюсь - там в 70% случаях только 3Д и спасет.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 24.09.2007, 15:46
#108
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Ну сначало вроде оси раскидываю а уж по ним все остальное.
Делать привязку "по жизни", нет уж увольте. У нас каждый призводитель норовит свои правила установить в обработке, вот и приходится вы..кручиваться.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Автор темы   Непрочитано 24.09.2007, 15:48
#109
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


И фасады как правило гнутохитрые :wink:
ps спасибо всем кто помог, очень нужная весчь получилась.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 04.04.2008, 09:51
#110
Log_in

Инженер-электрик
 
Регистрация: 16.01.2007
Москва
Сообщений: 19


Попробовал нумерацию. Все понравилось, все хорошо. Есть одна маленькая просьба... Нельзя ли подправить код чтобы нумерация шла не только на 1 блок, например с именем prof1. А нумеровались все выделенные блоки с именами prof1, prof2.... profn. Т.е. чтобы выделеным блокам prof1...profn, имеющим одинаковую длину присваивались разные позиции?

PS ну точно придется браться за изучение лиспа))
Log_in вне форума  
 
Непрочитано 29.07.2008, 11:16
#111
OHUKC


 
Регистрация: 29.07.2008
Сообщений: 55


Здоровапомогите разобраться, из какого хоста взять код проги, автокадовский файл с блоками, и так как не силён в лиспе -пошаговую инструкцию по применению проги....очень помогло бы в работе...а то часто приходится маркировать прямоугольные блоки.....заранее СПАСИБО
OHUKC вне форума  
 
Непрочитано 29.07.2008, 11:33
#112
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Сам-то понял чего сказал?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 29.07.2008, 11:52
#113
OHUKC


 
Регистрация: 29.07.2008
Сообщений: 55


ты не мог бы конечный код проги скинуть......автокадовский файл с блоком стойки, к которому она применяется....
как LISP файл подгружать я знаю....
а вот как её потом в автокаде на блоке применить????....
в командной строке прописывал -не получается.....
OHUKC вне форума  
 
Непрочитано 29.07.2008, 11:58
#114
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Варианты лиспа и файлы находятся в постах #21, #47.
Что делать с лиспом смотри в моей подписи.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 29.07.2008, 12:03
#115
OHUKC


 
Регистрация: 29.07.2008
Сообщений: 55


а чем код в лиспе №21 от кода в лиспе №47 отличается???
объясни пожалуйста: я вставляю блоки , меняю их длину , потом прописываю в ком. строке _regenall, а затем (try-to-renum "dlina" "pos"),
нажимаю ENTER, а затем что???
OHUKC вне форума  
 
Непрочитано 29.07.2008, 12:10
#116
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
а чем код в лиспе №21 от кода в лиспе №47 отличается???
Это разные программы, хотя, наверное, должны делать одно и то же (темы не перечитывал, а так уже на помню)
Нашел еще лисп и файл в #97 и #98
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 29.07.2008, 12:45
#117
OHUKC


 
Регистрация: 29.07.2008
Сообщений: 55


а какой порядок действий в автокаде должен быть???
подгрузил LISP ФАЙЛ
ВСТАВИЛ НЕСКОЛЬКО БЛОКОВ
В КОМ.СТРОКЕ : _regenall
затем : (try-to-renum "dlina" "pos")
а ДАЛЬШЕ???????
OHUKC вне форума  
 
Непрочитано 29.07.2008, 13:37
#118
OHUKC


 
Регистрация: 29.07.2008
Сообщений: 55


всё разобрался как запускать....клёвая прога
не подскажите теперь как мне сделать так чтоб не вертикально блок растягивался ,а горизонтально?т.е как мне атрибут длина привязать к гор.размеру?????
OHUKC вне форума  
 
Автор темы   Непрочитано 29.07.2008, 13:44
#119
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Почитай про динамические блоки, Help крутая штука
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 29.07.2008, 14:03
#120
OHUKC


 
Регистрация: 29.07.2008
Сообщений: 55



ВСЁ РАЗОБРАЛСЯ ....
спасибо
а как сделать так чтоб маркировка всегда по центру оставалась???
OHUKC вне форума  
 
Непрочитано 29.07.2008, 14:07
#121
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


http://dwg.ru/f/showpost.php?p=236819&postcount=1
http://dwg.ru/f/showthread.php?t=8940
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 04.08.2008, 09:01
#122
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Очень нужная тема!
А можно сделать тоже самое, но уже отталкиваться от 2х свойств?
У меня динамический блок - панель. Размеры меняются динамически, а позицию я присваиваю вручную. Типа А1, А2... На небольшой объект доходит до 200 типов
Кроме того можно и сбиться, а потом искать где ввел 2 одинаковых имени для разных размеров. Контролирую наличие с помощью _dataextraction.
Отличия моего блока:
- определяющие размеры "длина" и "ширина" - свойства д.блока
- шаг изменения 1 мм. (закреплено в свойствах д.блока)
- нет атрибутов "длина" "ширина"(свойства д.блоков извлекаются также хорошо, как и читаются лиспом)
- маркировка блоков м.б. А1,А2... B1, B2...где буква означает цвет панели, а цифра - уникальное сочетание длины и ширины.

Блок прилагается.
Вложения
Тип файла: rar кассета.rar (249.2 Кб, 201 просмотров)
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 05.08.2008, 14:26
#123
OHUKC


 
Регистрация: 29.07.2008
Сообщений: 55


ПриветА не подскажите почему в динамических блоках штриховкавнутри тела при изменении не растягивается??
или ссылку на сообщение киньте пожалуйста на что-нить похожее
OHUKC вне форума  
 
Автор темы   Непрочитано 05.08.2008, 15:27
#124
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Цитата:
Сообщение от OHUKC Посмотреть сообщение
ПриветА не подскажите почему в динамических блоках штриховкавнутри тела при изменении не растягивается??
или ссылку на сообщение киньте пожалуйста на что-нить похожее
Мне так думается, что штриховка не ассоциативная, нет???
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 05.08.2008, 15:58
#125
OHUKC


 
Регистрация: 29.07.2008
Сообщений: 55


а поподробнее))где мне ассоциативность штриховки указать????
OHUKC вне форума  
 
Автор темы   Непрочитано 05.08.2008, 16:13
#126
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Цитата:
Сообщение от OHUKC Посмотреть сообщение
а поподробнее))где мне ассоциативность штриховки указать????
ассоциативность задается при создании штриховки
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon на форуме  
 
Непрочитано 05.08.2008, 16:26
#127
OHUKC


 
Регистрация: 29.07.2008
Сообщений: 55


посмотри пожалуйста...чёт у меня ничё не получается
Вложения
Тип файла: dwg
DWG 2004
узел.dwg (653.4 Кб, 1381 просмотров)
OHUKC вне форума  
 
Непрочитано 06.08.2008, 03:08
#128
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Цитата:
Сообщение от OHUKC Посмотреть сообщение
а поподробнее))где мне ассоциативность штриховки указать????
http://dwg.ru/f/showthread.php?t=8940&page=28

пост 553
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)

Последний раз редактировалось wetr, 06.08.2008 в 03:39.
wetr вне форума  
 
Непрочитано 06.08.2008, 10:37
#129
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Ассоциативность штриховки указывается при ее создании. Просто поставь галочку "Associative"
Миниатюры
Нажмите на изображение для увеличения
Название: 1111.jpg
Просмотров: 175
Размер:	66.6 Кб
ID:	9023  
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 06.08.2008, 10:56
#130
OHUKC


 
Регистрация: 29.07.2008
Сообщений: 55


спасибо..поставил...тока всё-равно нифига не растягивается
OHUKC вне форума  
 
Непрочитано 06.08.2008, 11:42
#131
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


читай по ссылке в 128 посте - здесь не та тема
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 06.08.2008, 11:50
#132
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


wetr, это относилось к удаленному посту OHUKC'a, как я понимаю?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 06.08.2008, 13:59
#133
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Кулик Алексей aka kpblc, это относится к посту №130
Цитата:
спасибо..поставил...тока всё-равно нифига не растягивается
А по моему вопросу не выскажешь мнение (№122)?
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 06.08.2008, 21:21
#134
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


wetr,
Особо не проверял. Файл для примера в #122
Код:
[Выделить все]
;_ Маркировка динамических блоков для Wetr
(defun c:NDB_W ( / adoc ss name bname lst lstLen poz attTo 
                            *error* dynProp1 dynProp2 dp1 dp2 i
              )
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
 (vl-load-com)
 (defun *error* (msg)(princ msg)(vla-EndUndoMark adoc)) 
  (setq bname "*") ;_Имя блока 
  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
  (setq attTo "NAME") ;_Имя аттрибута куда вбивать

  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
;;;============================================================= 
;;;====================== MAIN PART ============================ 
;;;============================================================= 
  (vla-StartUndoMark adoc)
  (setq *PREF* (mip-conv-to-str *PREF*))
  (setq *SUFF* (mip-conv-to-str *SUFF*))
  (princ "\nВведите префикс или Пробел - нет <")(princ *PREF*)(princ ">: ")
  (setq poz (getstring t))
  (if (/= poz "")(setq *PREF* poz))(if (= poz " ")(setq *PREF* ""))
  (princ "\nВведите суффикс или Пробел - нет <")(princ *SUFF*)(princ ">: ")
  (setq poz (getstring t))
  (if (/= poz "")(setq *SUFF* poz))(if (= *SUFF* " ")(setq *SUFF* ""))
  (if (and (setq ss (ssget  '((0 . "INSERT")(66 . 1))))
	   (princ "\nЭтап 1. Построение списка блоков.")
           (setq lstLen (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
           )
    (progn
      (princ "\nЭтап 2. Анализ блоков.")
      (setq i 0  lstLen (mapcar 'vlax-ename->vla-object lstlen))
      (foreach blk lstLen
        (setq name (cond 
                     ((and (vlax-property-available-p blk 'isdynamicblock) 
                           (= (vla-get-isdynamicblock blk) :vlax-true) 
                           ) ;_ end of and 
                      (vla-get-effectivename blk) 
                      ) 
                     (t (vla-get-name blk)) 
                     ) ;_ end of cond
	      i (1+ i)
              ) ;_ end of setq 
        (if (and (wcmatch (strcase name)(strcase bname))
		 (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
		 (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
		 )
	  (progn
          (setq lst (cons (strcat (itoa(fix dp1))":"(itoa(fix dp2))) lst))
	  )
	  ) 
         ;_ end of if 
        ) ;_ end of foreach
      (princ "... Обработано ")(princ i)(princ " блоков")
      (princ "\nЭтап 3. Построение списка из уникальных значений.")
      (setq lst (mip_MakeUniqueMembersOfList lst))
      (princ "\nЭтап 4. Обновление атрибутов блоков.")(setq i 0)
      (foreach blk lstLen
        (setq name (cond 
                     ((and (vlax-property-available-p blk 'isdynamicblock) 
                           (= (vla-get-isdynamicblock blk) :vlax-true) 
                           ) ;_ end of and 
                      (vla-get-effectivename blk) 
                      ) 
                     (t (vla-get-name blk)) 
                     ) ;_ end of cond
	      i (1+ i)
              ) ;_ end of setq 
        (if (and (wcmatch (strcase name)(strcase bname))
		 (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
		 (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
		 (setq poz (vl-position (strcat (itoa(fix dp1))":"(itoa(fix dp2))) lst))
		 )
	  (progn
          (mip-block-setattr-bylist blk
              (list (cons (strcase attTo)(strcat *PREF* (itoa (1+ poz)) *SUFF*))))
	  )
	  ) 
         ;_ end of if 
        ) ;_ end of foreach
      (princ "... Обновлено ")(princ i)(princ " атрибутов в блоках \n")
      (vla-regen adoc acactiveviewport) 
      ) ;_ end of progn 
    ) ;_ end of if
  (vla-EndUndoMark adoc)
  (princ) 
  )

(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))))
(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-block-setattr-bylist (obj att_list / txt lst) 
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj))) 
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list)) 
  (if (and obj 
           (not(vlax-erased-p obj)) 
           (= (vla-get-ObjectName obj) "AcDbBlockReference") 
      (eq :vlax-true (vla-get-HasAttributes obj)) 
      (vlax-property-available-p obj 'Hasattributes) 
      (vlax-write-enabled-p obj) 
      ) 
    (vl-catch-all-apply 
      (function 
   (lambda   () 
          (foreach at (vlax-invoke obj 'Getattributes) 
            (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list)) 
              (vla-put-TextString at (cdr lst)) 
            ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
(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 mip-put-hyperlink (ENAME URLDescription) 
  (if (eq (type ENAME) 'ENAME) 
    (setq ENAME (vlax-ename->vla-object ENAME)) 
  ) ;_ end of if 
  (vlax-for hyp (vla-get-hyperlinks ENAME) (vla-delete hyp)) 
  (vla-add (vla-get-hyperlinks ENAME) 
           "about:blank" 
           URLDescription 
  ) ;_ end of vla-add 
) ;_ end of DEFUN 

;;;Удаляет одинаковые (дубликаты) элементы из списка 
;;;(defun mip_MakeUniqueMembersOfList  ( lst / OutList head) 
;;;  (while lst 
;;;    (setq head (car lst) 
;;;          lst (vl-remove head lst) 
;;;          OutList (append OutList (list head)))) 
;;;  OutList 
;;;  ) 
(defun mip_MakeUniqueMembersOfList  ( lst / OutList head) 
  (while lst 
    (setq head (car lst) 
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6)) lst) 
          OutList (append OutList (list head)))) 
  OutList 
  ) 
(defun member-i ( lst num / i) 
 (setq i 0)(while (and lst (not(equal (car lst) num 1e-6))) 
    (setq i (1+ i) lst(cdr lst))) 
  (if (equal (car lst) num 1e-6) i nil)) 
  (defun get-all-atts (obj) 

  (if (and obj 
      (eq :vlax-true (vla-get-HasAttributes obj)) 
      (vlax-property-available-p obj 'Hasattributes) 
       
      ) 
    (vl-catch-all-apply 
      (function 
   (lambda   () 
     (mapcar (function (lambda (x) 
               (cons (vla-get-TagString x) 
                (vla-get-TextString x) 
               ) 
             ) 
        ) 
        (append (vlax-invoke obj 'Getattributes) 
           (vlax-invoke obj 'Getconstantattributes) 
        ) 
     ) 
   ) 
      ) 
    ) 
  ) 
)
Настройки см. здесь
Код:
[Выделить все]
  (setq bname "*") ;_Имя блока 
  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
  (setq attTo "NAME") ;_Имя аттрибута куда вбивать
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 08.08.2008 в 12:07. Причина: Новая редакция
VVA вне форума  
 
Непрочитано 07.08.2008, 08:07
#135
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


VVA, очередное мега СПАСИБО
Работает как надо, даже с разными блоками (именами). Думаю эту наработку - блок и лисп - нужно взять многим фасадчикам на вооружение!
Offtop: ЗЫ Как расшифровывается "mip" ?
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 07.08.2008, 12:08
#136
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


wetr, mip - МинскИнжПроект
Имена обрабатываемых блоков можно задавать здесь
Код:
[Выделить все]
(setq bname "*") ;_Имя блока
по шаблонам wcmatch:
(setq bname "*") ;_Все имена
(setq bname "B*");_С именами, начинающимися на B
(setq bname "B#*");_С именами, начинающимися на B и следующей цифрой
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 07.08.2008 в 12:21.
VVA вне форума  
 
Непрочитано 08.08.2008, 02:05
#137
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


VVA, а можно сделать, чтобы программа запоминала последний введенный суффикс и префикс?
Смотрю в к.строку:
Введите префикс или Пробел - нет <A>:
кажется нажму пробел - будет А по умолчанию - а получается, что вообще нет никакого префикса.
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 08.08.2008, 12:08
#138
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


wetr, Обновил код в #134
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 21.12.2009, 16:50
#139
Crane


 
Регистрация: 07.05.2009
Астрахань
Сообщений: 103


Цитата:
всё разобрался как запускать....клёвая прога
А можно повторить для особо одаренных ). В каком посте взять работающий лисп-файл для маркировки элементов по длинам. Как лисп подгрузить в акад вроде ясно. Запускать его потом из ком.строки?
__________________
Debes, ergo potes
Crane вне форума  
 
Непрочитано 22.12.2009, 03:02
#140
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Crane, лисп завязан на определенный блок с конкретными названиями свойств. Выложи свой блок сюда, если ничего не получается
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 22.12.2009, 10:02
#141
Crane


 
Регистрация: 07.05.2009
Астрахань
Сообщений: 103


Подскажите пожалуйста в каком посте взять работающий лисп-файл, как в нем указать нужный дин.блок и его свойства - для маркировки элементов по длинам. Как лисп подгружать в акад вроде ясно, а вызывать его с комстроки? Мой блок это стержень с изменяемой длиной. Будут два варианта горизонтальный и вертикальный.
Очень нужно, помогите плиз.
Вложения
Тип файла: dwg
DWG 2007
str.dwg (77.7 Кб, 2556 просмотров)
__________________
Debes, ergo potes

Последний раз редактировалось Crane, 23.12.2009 в 13:36.
Crane вне форума  
 
Непрочитано 14.09.2010, 13:04
#142
dafara


 
Регистрация: 31.05.2010
Сообщений: 37


Здравствуйте.
Проектирую ОПС, необходимо промаркировать извещатели (сквозная нумерация) по всему проекту. Пользуюсь программами для маркировки, но при этом, если где-нибудь в середине проекта один извещатель удаляется, то нужно перенумеровывать все остальные заново. Есть ли возможность пронумеровать их так, чтобы при удалении одного элемента, вся остальная цепочка перестраивалась автоматически? Пример.dwg
dafara вне форума  
 
Непрочитано 14.09.2010, 13:57
#143
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


Цитата:
Сообщение от dafara Посмотреть сообщение
Здравствуйте.
Проектирую ОПС, необходимо промаркировать извещатели (сквозная нумерация) по всему проекту. Пользуюсь программами для маркировки, но при этом, если где-нибудь в середине проекта один извещатель удаляется, то нужно перенумеровывать все остальные заново. Есть ли возможность пронумеровать их так, чтобы при удалении одного элемента, вся остальная цепочка перестраивалась автоматически? Вложение 45267
Можно. Для этого следует подписаться на соответствующее событие, на которое повесите свой код обработки.
__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:
hwd вне форума  
 
Непрочитано 14.09.2010, 14:06
#144
dafara


 
Регистрация: 31.05.2010
Сообщений: 37


hwd, а можно по подробнее? Может есть пример какой-нибудь?
dafara вне форума  
 
Непрочитано 14.09.2010, 14:18
#145
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


Цитата:
Сообщение от dafara Посмотреть сообщение
hwd, а можно по подробнее? Может есть пример какой-нибудь?
Чтобы "поподробнее" - вам сначала следует озвучить язык, на котором пишете код.
Если на .Net, то (ежели мне не изменяет память) "поймать" удаление примитива можно подписавшись на событие ObjectErased объекта Database. Однако я не думаю, что стоит это делать, поскольку событие будет генерироваться при удалении каждого примитива (насколько я помню). Если вы выбрали и удалили сразу несколько примитивов, к примеру у вас 10 000 вхождений блоков и вы удаляете номера с 5 по 15, то после удаления каждого примитива будет выполняться перенумерация. Сами должны понимать, что это будет не самый быстрый процесс. Лучше создать спец. команду, которую можно было бы вызвать принудительно, после удаления примитивов. Эта команда должна выбирать нужные вам вхождения блоков и выполнять корректировку нумерации - так будет быстрее (имхо).
Если пишете на Lisp - тут я не подскажу, однако юзать реакторы в данном вопросе всё так же не советую.

Пример возни с указанным мною событием:
Код:
[Выделить все]
//Microsoft
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
//Autodesk
using acad = Autodesk.AutoCAD.ApplicationServices.Application;
using Autodesk.AutoCAD.ApplicationServices;
using Autodesk.AutoCAD.DatabaseServices;
using Autodesk.AutoCAD.EditorInput;
using Autodesk.AutoCAD.Runtime;

namespace Bushman.GpsmTools
{
    public class Class1
    {
        DocumentCollection dm = acad.DocumentManager;
        Document dwg;
        Database db;
        Editor ed;
        const string ns = "hwd";//namespace of commands

        public Class1()
        {
            Drawing = acad.DocumentManager.MdiActiveDocument;
        }

        Document Drawing
        {
            get { return dwg; }
            set
            {
                dwg = value;
                if (dwg != null)
                {
                    db = dwg.Database; ed = dwg.Editor;
                }
                else
                {
                    db = null; ed = null;
                }
            }
        }

        [CommandMethod(ns, "cmd", CommandFlags.Modal)]
        public void Cmd()
        {
            db.ObjectErased += new ObjectErasedEventHandler(db_ObjectErased);
            ed.WriteMessage("\nПодписка на событие 'ObjectErased' произведена.\n");
        }

        void db_ObjectErased(object sender, ObjectErasedEventArgs e)
        {
            string operation = "Восстановлен";
            if (e.Erased) operation = "Удалён";
            ed.WriteMessage(string.Format("\n{0} примитив: '{1}'; ObjectId = {2}", operation, e.DBObject, e.DBObject.ObjectId));
        }
    }
}
Удаляем и восстанавливаем сразу три примитива, выбрав их рамкой:

__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:

Последний раз редактировалось hwd, 14.09.2010 в 14:40.
hwd вне форума  
 
Непрочитано 14.09.2010, 15:36
#146
dafara


 
Регистрация: 31.05.2010
Сообщений: 37


hwd, спасибо!
dafara вне форума  
 
Непрочитано 14.09.2010, 15:43
#147
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


Цитата:
Сообщение от dafara Посмотреть сообщение
hwd, спасибо!
Т.е. вопрос решен?
__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:
hwd вне форума  
 
Непрочитано 14.09.2010, 15:47
#148
dafara


 
Регистрация: 31.05.2010
Сообщений: 37


Да. Я просто понял, что такое мне не по зубам. Казалось, что проблема может решиться при помощи использования Полей, или связывания атрибутов блоков с таблицей, в которой можно было бы редактировать значения атрибутов. А на уровне программирования не осилить с моим уровнем знаний.
Спасибо за потраченное время..
dafara вне форума  
 
Непрочитано 26.10.2010, 17:00
#149
Eddicordo

КИП и А
 
Регистрация: 28.04.2010
Киев
Сообщений: 101
<phrase 1=


Доброго дня.
Нумерация блоков штучка интересная.
А можно сделать "Нумерация атрибутов в блоках из внешнего файла Excel или txt".
1) Имеются множества блоков с атрибутом "Позиция".
2) Имеется готовый файл Excel с позициями оборудования в котором пронумерован первый столбец А
Ячейка А1 = 1
Ячейка А2 = 2
Ячейка А3 = 2а
Ячейка А4 = 3
Ячейка А5 = 3а
Ячейка А6 = 3б
Ячейка А7 = 4
и т.д.

При запуске LISP:
3) Запрос на выбор EXCEL файла (Запоминание этого Excel файла).
4) Запрос выбора позиции
(princ "\nВведите номер позиции")
5) Ввод вручную позиции (к примеру "2а")
6) Lisp сверяет введенную позицию "2а" с выбранным EXCEL файлом и столбом А
7) Если находит "2а" то запрос выбрать дин. блоки с атрибутом "Позиция" и вставить ячейку А3 (см. пункт 2 "Ячейка А3 = 2а").
8) После вставки позиции в атрибут, подсветить атрибут цветом.
9) Если не находит "2а" то повтор.
(princ "\nДанной позиции не существует")
(princ "\nВведите номер позиции")

10) При повторном запуске lisp сохранять предыдущий вод позиции.

10) И самое необходимое. Ради чего это все надо. При изменении позиций в ячейках этого же Excel файле (к примеру "2а" я заменил на "2б"), во всех дин блокам атрибуты с "2а" поменялись на "2б".
Eddicordo вне форума  
 
Непрочитано 26.10.2010, 17:28
#150
VoVoRoNaLe

Конструктор
 
Регистрация: 29.10.2007
Сообщений: 157


Цитата:
Сообщение от Eddicordo Посмотреть сообщение
А можно сделать "Нумерация атрибутов в блоках из внешнего файла Excel или txt".
Воспользуйтесь командами експорта и импорта атрибутов блоков AttIn и AttOut (Express Tools)
VoVoRoNaLe вне форума  
 
Непрочитано 27.10.2010, 17:11
#151
Eddicordo

КИП и А
 
Регистрация: 28.04.2010
Киев
Сообщений: 101
<phrase 1=


VoVoRoNaLe
На примитивном уровне то что надо. Но примитивный уровень для использования одноразовый.
Но суть конечно почти то что надо.
Исходя с команды AttOut:
1) Сохраняет только указанные конкретные блоки BLOCKNAME *U166.
Как быть если нужно добавить или удалить блоки с атрибутами к предыдущему списку в txt?

2) Вытягивает все атрибуты и лишнюю информацию в txt.
Как убрать лишнюю информацию, а оставить только атрибут "Позиция" для вывода в txt?

3) Сохраняет порядок записи txt в зависимости от последовательности указаний блоков.
Как отсортировать по алфавиту?

4) Если выделить несколько блоков одинаковых один в один. Создаст две разных записи. Хотя позиция может быть одинаковая.
Как свести все записи с одинаковыми атрибутами в одно?

С командой AttIn вопросов практически нет. Ну разве что как при пересчете подсветить все измененные атрибуты?

Идея то какова всего этого.
Имеется спецификация в которой каждому оборудованию присваивается позиция.
"Температура" ее позиция "1"
"Гильза для температуры" ее позиция "1а"
"Давление" ее позиция "2"
"Перепад давления" ее позиция "3"
и.д.

Эти позиции проставляются на чертеже. Причем на чертеже может быть как одна позиция "2" так и десять позиций "2".
Позиции имею жесткую сортировку 1а, 1б, 2, 3, 4а, 4б, 4в, 5 и т.д.
И во время проектирования могут добавляться (удалятся) новые блоки с атрибут "Позиция" которые должны встать между поз. 2 и 3. Тобиш все остальные поз. после 3 смещаются на единицу. Типа 1а, 1б, 2, 3, 4, 5а, 5б, 5в, 6.

Последний раз редактировалось Eddicordo, 27.10.2010 в 17:28.
Eddicordo вне форума  
 
Непрочитано 27.10.2010, 17:29
#152
saa


 
Регистрация: 25.09.2008
Новосибирск
Сообщений: 218


Если обрабатывать в Excel, то большинство вопросов легко решаются:
1) скопировать вновь извлеченные и добавить к предыдущему списку;
2) удалить лишние столбцы в Excel;
3) сортировка в Excel;
4) у одинаковых блоков одинаковое имя, использовать атрибут, содержащий поле с именем блока, по имени сортировать в Excel. Если блок динамический, то использовать атрибуты со значениями параметров блока, по ним и сортировать.
__________________
www.saa-blogs.blogspot.com
saa вне форума  
 
Непрочитано 28.10.2010, 09:56
#153
Eddicordo

КИП и А
 
Регистрация: 28.04.2010
Киев
Сообщений: 101
<phrase 1=


Да тут не суть важно где хранится сам список позиций. В Excel в txt, хоть сам AutoCad в табличной форме хранит позиции, либо другая внешняя программа.
Главное что бы:
1) Хранился список позиций.
2) Редактирование этого списка (добавить, удалить).
3) Сортировка списка по увеличению цифр.
4) Скрещение одинаковых атрибутов в одну.
5) Расстановка позиций со списка в разные блоки чертежа и чертежей.
6) При изменении списка позиций обновление всех блоков в одном и нескольких чертежах.
7) Подсвечивание внесенных атрибутов в список и измененных атрибутов в блоках.

Это касается не только позиций. А также можно будет использовать для расстановки номеров кабеля.
Короче говоря каждый найдет для себя применение.


Раньше использовал вот эту программу.
http://dwg.ru/dnl/101
Но она мало эффективная. При количестве (ячеек) позиций более 50 шт. начинает очень сильно тормозить. Не работает с атрибутами.
Нет возможности добавить новую позицию (ячейку) по сортировке. Приходилось новую позицию создавать в самом низу.
Короче не прижилась эта программка.
Для использования обычного пользователя очень заумная, тяжелая для использования.
Есть MyExpress.lsp кому интересно могу выложить поковыряться

Последний раз редактировалось Eddicordo, 28.10.2010 в 11:19.
Eddicordo вне форума  
 
Непрочитано 28.10.2010, 12:46
#154
VoVoRoNaLe

Конструктор
 
Регистрация: 29.10.2007
Сообщений: 157


Согласен с saa. Решаю ети задачи с помощю Excel. И многоразовых задач еще не встречал.
VoVoRoNaLe вне форума  
 
Непрочитано 28.10.2010, 13:45
#155
Eddicordo

КИП и А
 
Регистрация: 28.04.2010
Киев
Сообщений: 101
<phrase 1=


Цитата:
Сообщение от VoVoRoNaLe Посмотреть сообщение
Согласен с saa. Решаю ети задачи с помощю Excel.
Можно продемонстрировать на примере поэтапно.
Какой ход всего процесса.
Цитата:
Сообщение от VoVoRoNaLe Посмотреть сообщение
И многоразовых задач еще не встречал.
Возьмем примеры:
1) Проект в разработке.
Вы уже пронумеровали все позиции по всем чертежам. Во время работы к Вам приходят технологи с изменениями которые влекут за собой изменения в позициях.
Вам необходимо пронумеровать абсолютно все позиции заново.
Нумеруете в ручную изменяя атрибуты?
2) Проект готовый.
Заказчик захотел внести изменения которые опять же влекут за собой изменения позиций и вам же опять необходимо пронумеровать все позиции.
Нумеруете в ручную изменяя атрибуты?
Eddicordo вне форума  
 
Непрочитано 03.11.2010, 11:12
#156
Eddicordo

КИП и А
 
Регистрация: 28.04.2010
Киев
Сообщений: 101
<phrase 1=


Что все вбивают позиции вручную? И при изменения обновляют так же в ручную?
Или может кто то поделится дельным советом как проставлять удобно позиции и при изменениях, добавлении, удалении в одном месте обновлять их хоть каким то образом.
Сюда же можно отнести и Номера кабелям. Одни и те же номера на 5-20 чертежах. И при смещении или замене номеров кабеля обновление согласно какого то списка. В одном месте поменял позицию, номер кабеля. Обновил чертежи и получил результат и сокращение времени на пару дней.
Eddicordo вне форума  
 
Непрочитано 28.02.2011, 21:49
#157
Farest-1

Конструктор
 
Регистрация: 19.12.2005
Подольск
Сообщений: 54
<phrase 1= Отправить сообщение для Farest-1 с помощью Skype™


И так позаимствовав у Wetr его блоки решил пронумеровать кассеты на фасаде расставив использовал код от VVA в посте №134.
Всё бы хорошо но по подаются одинаковые блоки но с разной номерацией .
Файл с блоками прикладываю.
Вложения
Тип файла: rar Фасад.rar (906.4 Кб, 106 просмотров)
Farest-1 вне форума  
 
Непрочитано 02.03.2011, 23:35
#158
Farest-1

Конструктор
 
Регистрация: 19.12.2005
Подольск
Сообщений: 54
<phrase 1= Отправить сообщение для Farest-1 с помощью Skype™


Выкладываю спецификацию (в самом файле помечены желтым цветом повторяющиеся нумерации).
Кстати возможно ли в коде добавить ещё одну операцию например
есть 2-ва размера 744мм и 745мм -либо округлял или уменьшал.
Прошу в помощи в правке кода.

Код:
[Выделить все]
 ;_ Маркировка динамических блоков для Wetr
(defun c:NDB_W ( / adoc ss name bname lst lstLen poz attTo 
                            *error* dynProp1 dynProp2 dp1 dp2 i
              )
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
 (vl-load-com)
 (defun *error* (msg)(princ msg)(vla-EndUndoMark adoc)) 
  (setq bname "*") ;_Имя блока 
  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
  (setq attTo "NAME") ;_Имя аттрибута куда вбивать

  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
;;;============================================================= 
;;;====================== MAIN PART ============================ 
;;;============================================================= 
  (vla-StartUndoMark adoc)
  (setq *PREF* (mip-conv-to-str *PREF*))
  (setq *SUFF* (mip-conv-to-str *SUFF*))
  (princ "\nВведите префикс или Пробел - нет <")(princ *PREF*)(princ ">: ")
  (setq poz (getstring t))
  (if (/= poz "")(setq *PREF* poz))(if (= poz " ")(setq *PREF* ""))
  (princ "\nВведите суффикс или Пробел - нет <")(princ *SUFF*)(princ ">: ")
  (setq poz (getstring t))
  (if (/= poz "")(setq *SUFF* poz))(if (= *SUFF* " ")(setq *SUFF* ""))
  (if (and (setq ss (ssget  '((0 . "INSERT")(66 . 1))))
	   (princ "\nЭтап 1. Построение списка блоков.")
           (setq lstLen (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
           )
    (progn
      (princ "\nЭтап 2. Анализ блоков.")
      (setq i 0  lstLen (mapcar 'vlax-ename->vla-object lstlen))
      (foreach blk lstLen
        (setq name (cond 
                     ((and (vlax-property-available-p blk 'isdynamicblock) 
                           (= (vla-get-isdynamicblock blk) :vlax-true) 
                           ) ;_ end of and 
                      (vla-get-effectivename blk) 
                      ) 
                     (t (vla-get-name blk)) 
                     ) ;_ end of cond
	      i (1+ i)
              ) ;_ end of setq 
        (if (and (wcmatch (strcase name)(strcase bname))
		 (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
		 (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
		 )
	  (progn
          (setq lst (cons (strcat (itoa(fix dp1))":"(itoa(fix dp2))) lst))
	  )
	  ) 
         ;_ end of if 
        ) ;_ end of foreach
      (princ "... Обработано ")(princ i)(princ " блоков")
      (princ "\nЭтап 3. Построение списка из уникальных значений.")
      (setq lst (mip_MakeUniqueMembersOfList lst))
      (princ "\nЭтап 4. Обновление атрибутов блоков.")(setq i 0)
      (foreach blk lstLen
        (setq name (cond 
                     ((and (vlax-property-available-p blk 'isdynamicblock) 
                           (= (vla-get-isdynamicblock blk) :vlax-true) 
                           ) ;_ end of and 
                      (vla-get-effectivename blk) 
                      ) 
                     (t (vla-get-name blk)) 
                     ) ;_ end of cond
	      i (1+ i)
              ) ;_ end of setq 
        (if (and (wcmatch (strcase name)(strcase bname))
		 (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
		 (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
		 (setq poz (vl-position (strcat (itoa(fix dp1))":"(itoa(fix dp2))) lst))
		 )
	  (progn
          (mip-block-setattr-bylist blk
              (list (cons (strcase attTo)(strcat *PREF* (itoa (1+ poz)) *SUFF*))))
	  )
	  ) 
         ;_ end of if 
        ) ;_ end of foreach
      (princ "... Обновлено ")(princ i)(princ " атрибутов в блоках \n")
      (vla-regen adoc acactiveviewport) 
      ) ;_ end of progn 
    ) ;_ end of if
  (vla-EndUndoMark adoc)
  (princ) 
  )

(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))))
(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-block-setattr-bylist (obj att_list / txt lst) 
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj))) 
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list)) 
  (if (and obj 
           (not(vlax-erased-p obj)) 
           (= (vla-get-ObjectName obj) "AcDbBlockReference") 
      (eq :vlax-true (vla-get-HasAttributes obj)) 
      (vlax-property-available-p obj 'Hasattributes) 
      (vlax-write-enabled-p obj) 
      ) 
    (vl-catch-all-apply 
      (function 
   (lambda   () 
          (foreach at (vlax-invoke obj 'Getattributes) 
            (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list)) 
              (vla-put-TextString at (cdr lst)) 
            ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
(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 mip-put-hyperlink (ENAME URLDescription) 
  (if (eq (type ENAME) 'ENAME) 
    (setq ENAME (vlax-ename->vla-object ENAME)) 
  ) ;_ end of if 
  (vlax-for hyp (vla-get-hyperlinks ENAME) (vla-delete hyp)) 
  (vla-add (vla-get-hyperlinks ENAME) 
           "about:blank" 
           URLDescription 
  ) ;_ end of vla-add 
) ;_ end of DEFUN 

;;;Удаляет одинаковые (дубликаты) элементы из списка 
;;;(defun mip_MakeUniqueMembersOfList  ( lst / OutList head) 
;;;  (while lst 
;;;    (setq head (car lst) 
;;;          lst (vl-remove head lst) 
;;;          OutList (append OutList (list head)))) 
;;;  OutList 
;;;  ) 
(defun mip_MakeUniqueMembersOfList  ( lst / OutList head) 
  (while lst 
    (setq head (car lst) 
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6)) lst) 
          OutList (append OutList (list head)))) 
  OutList 
  ) 
(defun member-i ( lst num / i) 
 (setq i 0)(while (and lst (not(equal (car lst) num 1e-6))) 
    (setq i (1+ i) lst(cdr lst))) 
  (if (equal (car lst) num 1e-6) i nil)) 
  (defun get-all-atts (obj) 

  (if (and obj 
      (eq :vlax-true (vla-get-HasAttributes obj)) 
      (vlax-property-available-p obj 'Hasattributes) 
       
      ) 
    (vl-catch-all-apply 
      (function 
   (lambda   () 
     (mapcar (function (lambda (x) 
               (cons (vla-get-TagString x) 
                (vla-get-TextString x) 
               ) 
             ) 
        ) 
        (append (vlax-invoke obj 'Getattributes) 
           (vlax-invoke obj 'Getconstantattributes) 
        ) 
     ) 
   ) 
      ) 
    ) 
  ) 
)
Вложения
Тип файла: rar Специф.rar (19.6 Кб, 119 просмотров)
Farest-1 вне форума  
 
Непрочитано 02.03.2011, 23:36
#159
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Цитата:
Сообщение от Farest-1 Посмотреть сообщение
в самом файле помечены желтым цветом повторяющиеся нумерации
Файла что-то не вижу... Или имеется в виду файл в #157?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 02.03.2011, 23:39
#160
Farest-1

Конструктор
 
Регистрация: 19.12.2005
Подольск
Сообщений: 54
<phrase 1= Отправить сообщение для Farest-1 с помощью Skype™


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Файла что-то не вижу... Или имеется в виду файл в #157?
Забыл изначально прикрепить (сейчас всё нормально).
Farest-1 вне форума  
 
Непрочитано 03.03.2011, 11:39
#161
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Farest-1 Посмотреть сообщение
Всё бы хорошо но по подаются одинаковые блоки но с разной номерацией .
Приведи пример (dwg файл) в котором всего пару блоков, которые нумеруются неправильно. Разбираться в 360 позициях времени нет

Цитата:
Сообщение от Farest-1 Посмотреть сообщение
Кстати возможно ли в коде добавить ещё одну операцию например
есть 2-ва размера 744мм и 745мм -либо округлял или уменьшал.
Это по всем динамическим свойствам или по одному?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 03.03.2011, 12:00
#162
Farest-1

Конструктор
 
Регистрация: 19.12.2005
Подольск
Сообщений: 54
<phrase 1= Отправить сообщение для Farest-1 с помощью Skype™


Цитата:
Сообщение от VVA Посмотреть сообщение
Приведи пример (dwg файл) в котором всего пару блоков, которые нумеруются неправильно. Разбираться в 360 позициях времени нет


Это по всем динамическим свойствам или по одному?
Выкладываю 2- блока которые нумеруются по разному.

Скорее всего по всем динамическим свойствам (если можно покажите 2-х вариантах нужно про бывать).
Вложения
Тип файла: rar 2блока.rar (128.7 Кб, 116 просмотров)
Farest-1 вне форума  
 
Непрочитано 03.03.2011, 14:01
#163
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Пробуй (пример см #162 и #157)
Текущая сборка 2011-12-08
Код:
[Выделить все]
;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #163
;;; Натройки программы проихводятся парой строчек ниже СМ
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
;;;  (setq bname "*") ;_Имя блока 
;;;  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
;;;  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
;;;  (setq attTo "POS") ;_Имя аттрибута куда вбивать

(defun c:NDB (/       adoc    ss      name    bname   lst     lstLen
              poz     attTo   *error* dynProp1        dynProp2
              dp1     dp2     i dimz
             )
;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #163
  
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
  (princ "\nNDB - Маркировка динамических блоков. сборка от 2011-12-08")
  (vl-load-com)
  (setq bname "*") ;_Имя блока 
  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
  (setq attTo "POS") ;_Имя аттрибута куда вбивать
  (or (numberp *STARTPOZ*)(setq *STARTPOZ* 1)) ;;; Стартовая нумерация
  
;;; ===================== LOCAL FUNCTION ==========================================
(defun *error* (msg) (princ msg)(setvar "DIMZIN" dimz)(vla-endundomark adoc))
(defun RemoveDuplicateStrings (stringlist / newlist)
  (foreach var stringlist 
    (if (not (vl-position var newlist))
      (setq newlist (cons var newlist))
    )
  )
  (reverse newlist)
)
  (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)))
  ) ;_ end of cond
) ;_ end of defun
(defun GetDynamicBlockPropertyList (obj)
 (mapcar
    (function
      (lambda ( prop )
        (list (vla-get-propertyname prop) (vlax-get prop 'Value) prop)
      )
    )
    (vlax-invoke obj 'GetDynamicBlockProperties)
  )
)
(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-block-setattr-bylist (obj att_list / txt lst)
  (if (= (type obj) 'ENAME)
    (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of if
  (setq att_list (mapcar '(lambda (x)
                            (cons (strcase (mip-conv-to-str (car x)))
                                  (mip-conv-to-str (cdr x))
                            ) ;_ end of cons
                          ) ;_ end of lambda
                         att_list
                 ) ;_ end of mapcar
  ) ;_ end of setq
  (if (and obj
           (not (vlax-erased-p obj))
           (= (vla-get-objectname obj) "AcDbBlockReference")
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)
           (vlax-write-enabled-p obj)
      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (foreach at (vlax-invoke obj 'Getattributes)
            (if (setq
                  lst (assoc (strcase (vla-get-tagstring at)) att_list)
                ) ;_ end of setq
              (vla-put-textstring at (cdr lst))
            ) ;_ end of if
          ) ;_ end of foreach
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun
(defun round (value to)
;;; Doug Broad
;;; additional credits Joe Burke, Peter Toby
  (setq to (abs to))
  (* to
     (fix (/ ((if (minusp value)
                -
                +
              ) ;_ end of if
               value
               (* to 0.5)
             )
             to
          ) ;_ end of /
     ) ;_ end of fix
  ) ;_ end of *
) ;_ end of defun  
(defun get-all-atts (obj)
  (if (and obj
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)

      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (mapcar (function (lambda (x)
                              (cons (vla-get-tagstring x)
                                    (vla-get-textstring x)
                              ) ;_ end of cons
                            ) ;_ end of lambda
                  ) ;_ end of function
                  (append (vlax-invoke obj 'Getattributes)
                          (vlax-invoke obj 'Getconstantattributes)
                  ) ;_ end of append
          ) ;_ end of mapcar
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun  
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  ;;;http://www.theswamp.org/index.php?topic=16564.msg207439;topicseen#msg207439
  ;;; http://www.theswamp.org/index.php?topic=6474.0
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
	 (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)
  ;;; ===================== LOCAL FUNCTION ==========================================

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
;;;============================================================= 
;;;====================== MAIN PART ============================ 
;;;============================================================= 
  (vla-startundomark adoc)
  (setq dimz (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (setq *PREF* (mip-conv-to-str *PREF*))
  (setq *SUFF* (mip-conv-to-str *SUFF*))
  (princ "\nВведите префикс или Пробел - нет <")
  (princ *PREF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *PREF* poz))
  (if (= poz " ")(setq *PREF* ""))
  (princ "\nВведите суффикс или Пробел - нет <")
  (princ *SUFF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *SUFF* poz))
  (if (= *SUFF* " ")(setq *SUFF* ""))
  (princ "\nКратность (5 - кратно 5; 0.5 - кратно 0.5) или 0 - нет <")
  (if (numberp *ROUND*)(princ *ROUND*)(princ "НЕТ"))
  (princ ">: ")(initget 4)
  (if (null (setq poz (getdist)))
    (setq poz (if (numberp *ROUND*) *ROUND*  0))
  ) ;_ end of if
  (if (zerop poz)(setq *ROUND* nil)(setq *ROUND* poz)) ;_ end of if
  (princ "\nНачальный номер <")(princ *STARTPOZ*)(princ ">: ")
  (if (null(setq i (getint)))(setq i *STARTPOZ*)(setq *STARTPOZ* i))
  (if (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
           (princ "\nЭтап 1. Построение списка блоков.")
           (setq lstLen (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      ) ;_ end of and
    (progn
      (princ "\nЭтап 2. Анализ блоков.")
      (setq i      0
            lstLen (mapcar 'vlax-ename->vla-object lstlen)
      ) ;_ end of setq
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
          ) ;_ end of and
           (progn
             (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                       )
             ) ;_ end of if
             (setq lst
                    (cons (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9)) lst)
             ) ;_ end of setq
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (princ "... Обработано ")(princ i)(princ " блоков")
      (princ "\nЭтап 3. Построение списка из уникальных значений.")
      (setq lst (SORTSTRINGWITHNUMBERASNUMBER (RemoveDuplicateStrings lst) nil))
      (princ "\nЭтап 4. Обновление атрибутов блоков.")
      (setq i 0)
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
               (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                 ) ;_ end of setq
                 t
               ) ;_ end of if
               (setq poz (vl-position
                           (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9))
                           lst
                         ) ;_ end of vl-position
               ) ;_ end of setq
          ) ;_ end of and
           (progn
             (mip-block-setattr-bylist
               blk
               (list (cons (strcase attTo)
                           (strcat *PREF* (itoa (+ *STARTPOZ* poz)) *SUFF*)
                     ) ;_ end of cons
               ) ;_ end of list
             ) ;_ end of mip-block-setattr-bylist
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (setq *STARTPOZ* (+ *STARTPOZ* (length lst)))
      (princ "... Обновлено ")(princ i)(princ " атрибутов в блоках \n")
      (vla-regen adoc acactiveviewport)
    ) ;_ end of progn 
  ) ;_ end of if
  (setvar "DIMZIN" dimz)
  (vla-endundomark adoc)(princ)
) ;_ end of defun
Настройки см. здесь
Код:
[Выделить все]
 (setq bname "*") ;_Имя блока 
  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
  (setq attTo "NAME") ;_Имя аттрибута куда вбивать
ПРИМЕР см. #168
Миниатюры
Нажмите на изображение для увеличения
Название: ndb1.png
Просмотров: 625
Размер:	83.7 Кб
ID:	71148  
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 09.12.2011 в 15:17. Причина: Сортировка+нумерация с любой позиции
VVA вне форума  
 
Непрочитано 03.03.2011, 23:02
#164
Farest-1

Конструктор
 
Регистрация: 19.12.2005
Подольск
Сообщений: 54
<phrase 1= Отправить сообщение для Farest-1 с помощью Skype™


VVA
Спасибо Большое работает по маркировке как нужно.
Вопрос что то не пойму про округление (возможно что то не так делаю-но там всё прописано какое значение ввести но увы не хочет округлять).
Или мы друг друга не понимаем, лучше выложу файл .
В файле (для наглядности 4-блока) у 1-го изменил высоту на 0.5мм у 2-го ширину 0.5мм - в итоге нужно округлить значения в кратное значение больше или меньше.
Вложения
Тип файла: rar Округление.rar (38.0 Кб, 91 просмотров)
Farest-1 вне форума  
 
Непрочитано 04.03.2011, 11:18
#165
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Farest-1 Посмотреть сообщение
Вопрос что то не пойму про округление
Округление запрашивает кратность округления.
Если на запрос "Округление (5 - кратно 5; 0.5 - кратно 0.5) или 0 - нет <НЕТ>:" ввести
1 - число 850 округлиться до 850
- число 851 округлиться до 851
- число 853 округлиться до 853
5 - число 850 округлиться до 850
- число 851 округлиться до 850
- число 853 округлиться до 855
0.5 - число 850.2 округлиться до 850
- число 850.3 округлиться до 850.5
- число 850.7 округлиться до 850.5
В твоем случае введи 5
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 24.11.2011, 16:43
#166
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


VVA замечательная программа
Лисп не знаю, но в этих строках так и должно быть? (setq dp2 (round dp1 *ROUND*)) и dp2 (round dp1 *ROUND*) или надо (setq dp2 (round dp2 *ROUND*)) и dp2 (round dp2 *ROUND*).
Просто жизненно необходимо сделать сортировку при назначении позиции, сначала пройтись по dynProp1, затем по dynProp2, а то получается при анализе какая то каша. Программа очень очень нужная, пожалуйста добавьте эту возможность.
Alex_80 вне форума  
 
Непрочитано 24.11.2011, 17:55
#167
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Alex_80 Посмотреть сообщение
исп не знаю, но в этих строках так и должно быть? (setq dp2 (round dp1 *ROUND*)) и dp2 (round dp1 *ROUND*)
Так не должно быть, это опечатка
Я исправил #163

Цитата:
Сообщение от Alex_80 Посмотреть сообщение
Программа очень очень нужная, пожалуйста добавьте эту возможность.
Это изменение решает проблему? Если нет, то нужно ТЗ поподробнее и пример ввиде dwg файла
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 24.11.2011, 21:51
#168
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Создал ТЗ.dwg. Там в таблице принцип группировки и объединения блоков по динамическим свойствам. Плюс для универсальности можно добавить возможность нумеровать с любой позиции. Например: «Команда: Введите позицию маркировки <1>: »
Вложения
Тип файла: dwg
DWG 2007
ТЗ.dwg (105.1 Кб, 2505 просмотров)
Alex_80 вне форума  
 
Непрочитано 25.11.2011, 12:03
#169
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Сортировку сделал. Поправил еще один баг. См. #163
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 25.11.2011, 13:21
#170
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Спасибо. Опробовал на двух разных динамических блоках. Всё получилось. Тестировал на AutoCAD 2012 32bit. Забивал в dynProp1 и dynProp2 разные свойства, нумерация чётко шла в зависимости от принятых свойств с сортировкой сначала по dynProp1, затем по dynProp2. Буду тестировать на более крупных объектах, через две недели отпишусь. Ещё раз спасибо.

Последний раз редактировалось Alex_80, 25.11.2011 в 13:27.
Alex_80 вне форума  
 
Непрочитано 03.12.2011, 14:12
#171
VENfas


 
Регистрация: 27.05.2010
Москва
Сообщений: 11


Спасибо, очень полезный макрос. Тестировал на AutoCAD 2012 32bit rus.
Единственное что не получилось, это пробел в префиксе и суффиксе, (т.е. ставишь пробел, в префиксе он опять спрашивает и так по кругу)
Цитата:
Сообщение от Alex_80 Посмотреть сообщение
Плюс для универсальности можно добавить возможность нумеровать с любой позиции
И нумерация с любой позиции весьма полезна.
VENfas вне форума  
 
Непрочитано 04.12.2011, 18:51
#172
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Цитата:
Сообщение от VENfas Посмотреть сообщение
Единственное что не получилось, это пробел в префиксе и суффиксе, (т.е. ставишь пробел, в префиксе он опять спрашивает и так по кругу)
Вместо пробелов жми Enter.
Alex_80 вне форума  
 
Непрочитано 05.12.2011, 10:44
1 | #173
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от VENfas Посмотреть сообщение
Единственное что не получилось, это пробел в префиксе и суффиксе
Просто пробел означает очистку префикса и суффикса.
Цитата:
Введите префикс или Пробел - нет <>:
Цитата:
И нумерация с любой позиции весьма полезна.
Раз полезна, добавил. См. #163
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 06.12.2011, 09:50
#174
VENfas


 
Регистрация: 27.05.2010
Москва
Сообщений: 11


Цитата:
Сообщение от VVA Посмотреть сообщение
И нумерация с любой позиции весьма полезна.
Раз полезна, добавил. См. #163
СПАСИБО все работает!
VENfas вне форума  
 
Непрочитано 08.12.2011, 13:46
#175
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Спасибо за труд. Возникли вопросы.
Почему при: «Округление (5 - кратно 5; 0.5 - кратно 0.5) или 0 - нет <НЕТ>: 0», десятичные значения все равно округляются до целых? В общем, я то же не понял принцип округления. На мой взгляд «Кратность» полезная штука, её нужно оставить, только при нуле пусть не работает, и добавить «Округление», как количество знаков после запятой.
Вложения
Тип файла: dwg
DWG 2007
Округление2.dwg (103.7 Кб, 2392 просмотров)
Alex_80 вне форума  
 
Непрочитано 08.12.2011, 15:38
#176
vporsh


 
Регистрация: 06.09.2009
Сообщений: 24


не работает
какими должны быть исходные блоки?
пишет в конце "обновлено . . . блоков" и ничего не изменилось
vporsh вне форума  
 
Непрочитано 08.12.2011, 15:51
#177
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Alex_80,
Цитата:
Сообщение от Alex_80 Посмотреть сообщение
Почему при: «Округление (5 - кратно 5; 0.5 - кратно 0.5) или 0 - нет <НЕТ>: 0», десятичные значения все равно округляются до целых?
Я не учитывал DIMZIN. Исправил. См. #163

Цитата:
Сообщение от Alex_80 Посмотреть сообщение
только при нуле пусть не работает
Она и не работала. Это было из-за DIMZIN

Цитата:
Сообщение от Alex_80 Посмотреть сообщение
и добавить «Округление», как количество знаков после запятой
А это для чего? я же ни куда не вывожу размеры?
Добавил в #163 печать даты сборки. Чтобы было понятно, что говорим про одну и ту же версию кода
Цитата:
Команда: ndb
NDB - Маркировка динамических блоков. сборка от 2011-12-08
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 08.12.2011, 16:24
#178
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Цитата:
Сообщение от vporsh Посмотреть сообщение
какими должны быть исходные блоки?
ПРИМЕР см. #168
Alex_80 вне форума  
 
Непрочитано 08.12.2011, 16:33
1 | #179
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от vporsh Посмотреть сообщение
какими должны быть исходные блоки?
Блоки могут быть любыми. Главное программе указать, какие динамические свойства считывать и в какой атрибут записывать. Настройки см. выделенное красным в #163. Либо используй блок из примера #168
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 08.12.2011, 16:35
#180
vporsh


 
Регистрация: 06.09.2009
Сообщений: 24


Ваш пример изучал, но все равно не получается
капировал один из блоков потом ndb и . . . ничего
vporsh вне форума  
 
Непрочитано 08.12.2011, 19:16
#181
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


vporsh, Файл покажи
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 08.12.2011, 19:54
#182
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


VVA работает. «Округление», как количество знаков после запятой добавлять не надо, это я сам запутался. Тестирую дальше.
Alex_80 вне форума  
 
Непрочитано 08.12.2011, 21:54
#183
vporsh


 
Регистрация: 06.09.2009
Сообщений: 24


программа не спрашивает какие динамические свойства считывать и в какой атрибут записывать
спрашивает суф., преф., с какого начинать нумерацию, выделить объекты
как настроить ?
в лиспе дилетант
строчки. выделенные красным скопировал с заменой в программу на место похожих
__________________
я Конструктор - вот Чертеж
ACAD 2011 eng 32
vporsh вне форума  
 
Непрочитано 09.12.2011, 07:42
#184
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Цитата:
Сообщение от vporsh Посмотреть сообщение
в лиспе дилетант
строчки. выделенные красным скопировал с заменой в программу на место похожих
Там лисп знать не надо, спасибо VVA. Настройки выделены красным для того, чтоб мы знали, где нужно подправить исходные данные, ничего копировать не надо, каждая строка настройки закомментирована, ошибиться не реально. Есть ещё шаблон имен обрабатываемых блоков, смотри пост #136.
Alex_80 вне форума  
 
Непрочитано 09.12.2011, 11:46
#185
vporsh


 
Регистрация: 06.09.2009
Сообщений: 24


Можно написать так?
(vl-load-com)
(setq bname "*") ;_Имя блока
(setq dynProp1 "*") ;_Имя динамического свойства1
(setq dynProp2 "*") ;_Имя динамического свойства1
(setq attTo "NAME") ;_Имя аттрибута куда вбивать
(or (numberp *STARTPOZ*)(setq *STARTPOZ* 1)) ;;; Стартовая нумерация

или в setq dynProp1 надо вписать ручками например "LI" главное, чтобы это L1 была в блоке
и т.д.

Файл вложить не получается с компа
__________________
я Конструктор - вот Чертеж
ACAD 2011 eng 32
vporsh вне форума  
 
Непрочитано 09.12.2011, 12:04
#186
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Выложи на файлообменник и дай здесь ссылку. можешь на avral.ru
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 09.12.2011, 12:42
#187
vporsh


 
Регистрация: 06.09.2009
Сообщений: 24


http://files.mail.ru/SXPODJ
__________________
я Конструктор - вот Чертеж
ACAD 2011 eng 32
vporsh вне форума  
 
Непрочитано 09.12.2011, 13:02
1 | #188
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


vporsh,
Код:
[Выделить все]
  (setq bname "*") ;_Имя блока 
  (setq dynProp1 "Distance1") ;_Имя динамического свойства1
  (setq dynProp2 "Distance2") ;_Имя динамического свойства1
  (setq attTo "NAME") ;_Имя аттрибута куда вбивать
Постарался нарисовать. Надеюсь получилось понятно

__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 09.12.2011 в 15:18.
VVA вне форума  
 
Непрочитано 09.12.2011, 13:06
#189
vporsh


 
Регистрация: 06.09.2009
Сообщений: 24


картинка не читабельна к сожалению
как ее увеличить без потери качества?
__________________
я Конструктор - вот Чертеж
ACAD 2011 eng 32
vporsh вне форума  
 
Непрочитано 09.12.2011, 15:14
#190
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Это картинка из #163. Посмотри там
***Добавлено***
Изменил немного масштаб изображение
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 09.12.2011, 15:49
#191
vporsh


 
Регистрация: 06.09.2009
Сообщений: 24


Да спасибо огромное, теперь все видно хорошо
Все работает, програмуля радует.Спасибо
Я так понимаю - для того чтобы перестроить програмку нада перегрузить акад
например нумерация блоков, начинающихся с буквы S
потом перегружаем акад и нумеруем все блоки, начинающиеся на букву К, преварительно подредактировав ndb.lsp
и т.д.
эх, хорошо-бы чтобы спрашивала не только суф, преф, округл, но и какие блоки и все остальное
или можно как-то обновлять энтот .lsp, не выходя из акада?
__________________
я Конструктор - вот Чертеж
ACAD 2011 eng 32
vporsh вне форума  
 
Непрочитано 09.12.2011, 16:32
1 | #192
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от vporsh Посмотреть сообщение
или можно как-то обновлять энтот .lsp, не выходя из акада?

_APPLOAD

Цитата:
Сообщение от vporsh Посмотреть сообщение
но и какие блоки и все остальное
подумаю
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 10.12.2011, 08:29
#193
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Вырисовывается второй вариант.
Сделать для всех настраиваемых данных (имена динамических свойств; суффикс; префикс; округление; выбор блоков по имени или маске; мышкой или _all; номер позиции) ввод с клавиатуры.
После этого можно будет создать в acade панель с кнопками, имеющие различные наборы настраиваемых данных для разных блоков. Таким образом не усложняя кода, добьёмся универсальности.
Как идея?
Alex_80 вне форума  
 
Непрочитано 31.01.2012, 10:51
#194
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Привет всем!
VVA так можно задавать параметры или могут возникнуть ошибки?
(setq bname ( GETSTRING "\n_Имя блока:" ))
(setq dynProp1 ( GETSTRING "\n_Имя динамического свойства1:" ))
(setq dynProp2 ( GETSTRING "\n_Имя динамического свойства2:" ))
Вот макрос кнопки для блока Кассета:
^C^C_NDB;Кассета;Ширина(B);Высота(H);Кассета-; ;;1;_all;;
Настройка через макрос кнопки. Вроде все работает.
;;;=====01.12.2012
Исправил на:
(setq bname ( GETSTRING T "\nИмя блока:" ))
(setq dynProp1 ( GETSTRING T "\nИмя динамического свойства 1:"))
(setq dynProp2 ( GETSTRING T "\nИмя динамического свойства 2:"))
Имена динамических свойств блока сделал одним словом.
^C^C_NDB;Кассета;Ширина;Высота;Кассета-; ;;1;_all;;
Вложения
Тип файла: dwg
DWG 2007
ТЗ.dwg (114.2 Кб, 1643 просмотров)
Тип файла: lsp NDB010212.lsp (12.3 Кб, 67 просмотров)

Последний раз редактировалось Alex_80, 01.02.2012 в 07:46.
Alex_80 вне форума  
 
Непрочитано 31.01.2012, 14:12
1 | #195
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Alex_80, Можно. Если использовать макрос, то название дин. свойств лучше задавать одним словом (без пробелов и желательно прочих спецсимволов вроде #^ и т.п.)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 31.01.2012, 14:16
1 | #196
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


А если заменить строку (getstring "\nБла-бла-бла") на (getstring t "\nБла-бла-бла") - то и пробелы можно будет использовать
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 31.01.2012, 16:23
1 | #197
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
А если заменить строку (getstring "\nБла-бла-бла") на (getstring t "\nБла-бла-бла") - то и пробелы можно будет использовать
Передать имена свойств с пробелами для запроса из макроса все равно будет проблематично. Нужно будет использовать что-то типа strcat, chr
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 05.04.2012, 07:39
#198
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Добрый день. Как добавить возможность выбора имен (имени) блоков мышкой?
Alex_80 вне форума  
 
Непрочитано 05.04.2012, 08:24
#199
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


А перевод?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 06.04.2012, 10:32
#200
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


В лиспе NDB есть (setq bname ( GETSTRING T "\nИмя блока:" )). Как добавить возможность выбора имен (имени) блоков мышкой?
Alex_80 вне форума  
 
Непрочитано 06.04.2012, 11:44
#201
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Замени
Код:
[Выделить все]
 (setq bname ( GETSTRING T "\nИмя блока:" ))
На
Код:
[Выделить все]
(setq bname
       ((lambda( / obj name)
          (while (not name)
            (initget "Имя")
            (setq obj (entsel "\nВыберите блок [Имя]: "))
            (cond ((and obj (eq obj "Имя"))(setq name(getstring T "\nИмя блока: " )))
                  ((and obj (eq (cdr(assoc 0 (entget(setq obj(car obj))))) "INSERT"))
                   (if (vlax-property-available-p (setq obj(vlax-ename->vla-object obj)) 'EffectiveName)
                     (setq name(vla-get-EffectiveName obj))
                     (setq name(vla-get-Name obj))
                     )
                   )
                  (t (princ " ** Неверно ** "))
                  )
            )
          name
          )
         )
      )
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 06.04.2012, 15:39
#202
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Не то.
Выберите блок [Имя]: - выбирается только один блок, ручной ввод теперь не воспринимается.
Я имел ввиду это:
Выберите блок [Имя]: -
а) здесь выбираем ЛК один или несколько блоков и затем блоки с этими именами будут попадать в набор.
б) если не был сделан выбор ЛК, а был ввод с клавиатуры имени (маска имен), то программа продолжает работать как раньше.
Alex_80 вне форума  
 
Непрочитано 06.04.2012, 16:37
#203
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Alex_80, Что такое опции знаешь?
Цитата:
Сообщение от Alex_80 Посмотреть сообщение
Выберите блок [Имя]
Имя - это опция, на запрос щелкни ПКМ, будет как раньше
Судя по запросу
Код:
[Выделить все]
(setq bname ( GETSTRING T "\nИмя блока:" ))
запрашивалось только одно имя блока. Этим и руководствовался.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 07.04.2012, 07:15
#204
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Цитата:
Сообщение от VVA Посмотреть сообщение
Имя - это опция, на запрос щелкни ПКМ, будет как раньше
Спасибо разобрался, сам бы и не догадался. Добавил в макрос кнопки «И;» и все заработало. Сделай пожалуйста, если не трудно, для набора ЛК несколько разных блоков.
Alex_80 вне форума  
 
Непрочитано 08.04.2012, 11:35
#205
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Alex_80, мне нужно видеть весь код (опубликуй или дай ссылку на пост), т.к.
Цитата:
Сообщение от VVA Посмотреть сообщение
Судя по запросу
Код:
[Выделить все]
(setq bname ( GETSTRING T "\nИмя блока:" ))
запрашивалось только одно имя блока.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 09.04.2012, 11:54
#206
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Вот он код:
Код:
[Выделить все]
 ;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #163
;;; Натройки программы проихводятся парой строчек ниже СМ
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
;;;  (setq bname "*") ;_Имя блока 
;;;  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
;;;  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
;;;  (setq attTo "POS") ;_Имя аттрибута куда вбивать

(defun c:NDB (/       adoc    ss      name    bname   lst     lstLen
              poz     attTo   *error* dynProp1        dynProp2
              dp1     dp2     i dimz
             )
;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #163
  
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
  (princ "\nNDB - Маркировка динамических блоков. сборка от 2011-12-08")
  (vl-load-com)
;;;  (setq bname "*") ;_Имя блока 
;;;  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
;;;  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
;;;  (setq bname ( GETSTRING T "\nИмя блока:" ))===Сделай пожалуйста, если не трудно, для набора ЛК несколько разных блоков===
  (setq bname
       ((lambda( / obj name)
          (while (not name)
            (initget "Имя")
            (setq obj (entsel "\nВыберите блок [Имя]: "))
            (cond ((and obj (eq obj "Имя"))(setq name(getstring T "\nИмя блока: " )))
                  ((and obj (eq (cdr(assoc 0 (entget(setq obj(car obj))))) "INSERT"))
                   (if (vlax-property-available-p (setq obj(vlax-ename->vla-object obj)) 'EffectiveName)
                     (setq name(vla-get-EffectiveName obj))
                     (setq name(vla-get-Name obj))
                     )
                   )
                  (t (princ " ** Неверно ** "))
                  )
            )
          name
          )
         )
      )
  (setq dynProp1 ( GETSTRING T "\nИмя динамического свойства 1:"))
  (setq dynProp2 ( GETSTRING T "\nИмя динамического свойства 2:"))
  (setq attTo "POS") ;_Имя аттрибута куда вбивать
  (or (numberp *STARTPOZ*)(setq *STARTPOZ* 1)) ;;; Стартовая нумерация
  
;;; ===================== LOCAL FUNCTION ==========================================
(defun *error* (msg) (princ msg)(setvar "DIMZIN" dimz)(vla-endundomark adoc))
(defun RemoveDuplicateStrings (stringlist / newlist)
  (foreach var stringlist 
    (if (not (vl-position var newlist))
      (setq newlist (cons var newlist))
    )
  )
  (reverse newlist)
)
  (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)))
  ) ;_ end of cond
) ;_ end of defun
(defun GetDynamicBlockPropertyList (obj)
 (mapcar
    (function
      (lambda ( prop )
        (list (vla-get-propertyname prop) (vlax-get prop 'Value) prop)
      )
    )
    (vlax-invoke obj 'GetDynamicBlockProperties)
  )
)
(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-block-setattr-bylist (obj att_list / txt lst)
  (if (= (type obj) 'ENAME)
    (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of if
  (setq att_list (mapcar '(lambda (x)
                            (cons (strcase (mip-conv-to-str (car x)))
                                  (mip-conv-to-str (cdr x))
                            ) ;_ end of cons
                          ) ;_ end of lambda
                         att_list
                 ) ;_ end of mapcar
  ) ;_ end of setq
  (if (and obj
           (not (vlax-erased-p obj))
           (= (vla-get-objectname obj) "AcDbBlockReference")
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)
           (vlax-write-enabled-p obj)
      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (foreach at (vlax-invoke obj 'Getattributes)
            (if (setq
                  lst (assoc (strcase (vla-get-tagstring at)) att_list)
                ) ;_ end of setq
              (vla-put-textstring at (cdr lst))
            ) ;_ end of if
          ) ;_ end of foreach
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun
(defun round (value to)
;;; Doug Broad
;;; additional credits Joe Burke, Peter Toby
  (setq to (abs to))
  (* to
     (fix (/ ((if (minusp value)
                -
                +
              ) ;_ end of if
               value
               (* to 0.5)
             )
             to
          ) ;_ end of /
     ) ;_ end of fix
  ) ;_ end of *
) ;_ end of defun  
(defun get-all-atts (obj)
  (if (and obj
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)

      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (mapcar (function (lambda (x)
                              (cons (vla-get-tagstring x)
                                    (vla-get-textstring x)
                              ) ;_ end of cons
                            ) ;_ end of lambda
                  ) ;_ end of function
                  (append (vlax-invoke obj 'Getattributes)
                          (vlax-invoke obj 'Getconstantattributes)
                  ) ;_ end of append
          ) ;_ end of mapcar
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun  
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  ;;;http://www.theswamp.org/index.php?topic=16564.msg207439;topicseen#msg207439
  ;;; http://www.theswamp.org/index.php?topic=6474.0
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
	 (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)
  ;;; ===================== LOCAL FUNCTION ==========================================

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
;;;============================================================= 
;;;====================== MAIN PART ============================ 
;;;============================================================= 
  (vla-startundomark adoc)
  (setq dimz (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (setq *PREF* (mip-conv-to-str *PREF*))
  (setq *SUFF* (mip-conv-to-str *SUFF*))
  (princ "\nВведите префикс или Пробел - нет <")
  (princ *PREF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *PREF* poz))
  (if (= poz " ")(setq *PREF* ""))
  (princ "\nВведите суффикс или Пробел - нет <")
  (princ *SUFF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *SUFF* poz))
  (if (= *SUFF* " ")(setq *SUFF* ""))
  (princ "\nКратность (5 - кратно 5; 0.5 - кратно 0.5) или 0 - нет <")
  (if (numberp *ROUND*)(princ *ROUND*)(princ "НЕТ"))
  (princ ">: ")(initget 4)
  (if (null (setq poz (getdist)))
    (setq poz (if (numberp *ROUND*) *ROUND*  0))
  ) ;_ end of if
  (if (zerop poz)(setq *ROUND* nil)(setq *ROUND* poz)) ;_ end of if
  (princ "\nНачальный номер <")(princ *STARTPOZ*)(princ ">: ")
  (if (null(setq i (getint)))(setq i *STARTPOZ*)(setq *STARTPOZ* i))
  (if (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
           (princ "\nЭтап 1. Построение списка блоков.")
           (setq lstLen (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      ) ;_ end of and
    (progn
      (princ "\nЭтап 2. Анализ блоков.")
      (setq i      0
            lstLen (mapcar 'vlax-ename->vla-object lstlen)
      ) ;_ end of setq
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
          ) ;_ end of and
           (progn
             (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                       )
             ) ;_ end of if
             (setq lst
                    (cons (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9)) lst)
             ) ;_ end of setq
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (princ "... Обработано ")(princ i)(princ " блоков")
      (princ "\nЭтап 3. Построение списка из уникальных значений.")
      (setq lst (SORTSTRINGWITHNUMBERASNUMBER (RemoveDuplicateStrings lst) nil))
      (princ "\nЭтап 4. Обновление атрибутов блоков.")
      (setq i 0)
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
               (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                 ) ;_ end of setq
                 t
               ) ;_ end of if
               (setq poz (vl-position
                           (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9))
                           lst
                         ) ;_ end of vl-position
               ) ;_ end of setq
          ) ;_ end of and
           (progn
             (mip-block-setattr-bylist
               blk
               (list (cons (strcase attTo)
                           (strcat *PREF* (itoa (+ *STARTPOZ* poz)) *SUFF*)
                     ) ;_ end of cons
               ) ;_ end of list
             ) ;_ end of mip-block-setattr-bylist
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (setq *STARTPOZ* (+ *STARTPOZ* (length lst)))
      (princ "... Обновлено ")(princ i)(princ " атрибутов в блоках \n")
      (vla-regen adoc acactiveviewport)
    ) ;_ end of progn 
  ) ;_ end of if
  (setvar "DIMZIN" dimz)
  (vla-endundomark adoc)(princ)
) ;_ end of defun

Alex_80 вне форума  
 
Непрочитано 16.04.2012, 11:08
3 | #207
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Пробуй
Код:
[Выделить все]
;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #207, #163
;;; Натройки программы проихводятся парой строчек ниже СМ
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
;;;  (setq bname "*") ;_Имя блока 
;;;  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
;;;  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
;;;  (setq attTo "POS") ;_Имя аттрибута куда вбивать

(defun c:NDB (/       adoc    ss      name    bname   lst     lstLen
              poz     attTo   *error* dynProp1        dynProp2
              dp1     dp2     i dimz
             )
;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #163
  
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
  (princ "\nNDB - Маркировка динамических блоков. сборка от 2011-12-08")
  (vl-load-com)
;;;  (setq bname "*") ;_Имя блока 
;;;  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
;;;  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
;;;  (setq bname ( GETSTRING T "\nИмя блока:" ))===Сделай пожалуйста, если не трудно, для набора ЛК несколько разных блоков===
  (setq bname
       ((lambda( / obj name flg str)
          (while (not flg)
            (initget "Имя Удалить")
            (if name
              (setq str (VL-PRINC-TO-STRING name))
              ;;;(setq str (strcat (car name)(apply 'strcat (mapcar '(lambda(x)(strcat "," x))(cdr name)))))
              (setq str "")
              )
            (setq obj (entsel(strcat "\n" str " Выберите блок [Имя/Удалить]<готово>: ")))
            (cond ((and obj (eq obj "Имя"))(setq name (cons (getstring T "\nИмя блока: " ) name)))
                  ((and obj (eq obj "Удалить"))(if (null name)(princ " ** Все удалено **")(setq name (cdr name))))
                  ((and obj (eq (cdr(assoc 0 (entget(setq obj(car obj))))) "INSERT"))
                   (if (not(member(vla-get-EffectiveName(setq obj(vlax-ename->vla-object obj))) name))
                     (setq name (cons (vla-get-EffectiveName obj) name))
                     )
                   )
                  ((and (null obj)(= (getvar "ERRNO") 52))(setq flg t))
                  (t (princ " ** Неверно ** "))
                  )
            )
         (apply 'strcat(mapcar '(lambda(x)(strcat x ",")) name))
          )
         )
      )
  (setq dynProp1 ( GETSTRING T "\nИмя динамического свойства 1:"))
  (setq dynProp2 ( GETSTRING T "\nИмя динамического свойства 2:"))
  (setq attTo "POS") ;_Имя аттрибута куда вбивать
  (or (numberp *STARTPOZ*)(setq *STARTPOZ* 1)) ;;; Стартовая нумерация
  
;;; ===================== LOCAL FUNCTION ==========================================
(defun *error* (msg) (princ msg)(setvar "DIMZIN" dimz)(vla-endundomark adoc))
(defun RemoveDuplicateStrings (stringlist / newlist)
  (foreach var stringlist 
    (if (not (vl-position var newlist))
      (setq newlist (cons var newlist))
    )
  )
  (reverse newlist)
)
  (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)))
  ) ;_ end of cond
) ;_ end of defun
(defun GetDynamicBlockPropertyList (obj)
 (mapcar
    (function
      (lambda ( prop )
        (list (vla-get-propertyname prop) (vlax-get prop 'Value) prop)
      )
    )
    (vlax-invoke obj 'GetDynamicBlockProperties)
  )
)
(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-block-setattr-bylist (obj att_list / txt lst)
  (if (= (type obj) 'ENAME)
    (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of if
  (setq att_list (mapcar '(lambda (x)
                            (cons (strcase (mip-conv-to-str (car x)))
                                  (mip-conv-to-str (cdr x))
                            ) ;_ end of cons
                          ) ;_ end of lambda
                         att_list
                 ) ;_ end of mapcar
  ) ;_ end of setq
  (if (and obj
           (not (vlax-erased-p obj))
           (= (vla-get-objectname obj) "AcDbBlockReference")
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)
           (vlax-write-enabled-p obj)
      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (foreach at (vlax-invoke obj 'Getattributes)
            (if (setq
                  lst (assoc (strcase (vla-get-tagstring at)) att_list)
                ) ;_ end of setq
              (vla-put-textstring at (cdr lst))
            ) ;_ end of if
          ) ;_ end of foreach
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun
(defun round (value to)
;;; Doug Broad
;;; additional credits Joe Burke, Peter Toby
  (setq to (abs to))
  (* to
     (fix (/ ((if (minusp value)
                -
                +
              ) ;_ end of if
               value
               (* to 0.5)
             )
             to
          ) ;_ end of /
     ) ;_ end of fix
  ) ;_ end of *
) ;_ end of defun  
(defun get-all-atts (obj)
  (if (and obj
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)

      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (mapcar (function (lambda (x)
                              (cons (vla-get-tagstring x)
                                    (vla-get-textstring x)
                              ) ;_ end of cons
                            ) ;_ end of lambda
                  ) ;_ end of function
                  (append (vlax-invoke obj 'Getattributes)
                          (vlax-invoke obj 'Getconstantattributes)
                  ) ;_ end of append
          ) ;_ end of mapcar
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun  
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  ;;;http://www.theswamp.org/index.php?topic=16564.msg207439;topicseen#msg207439
  ;;; http://www.theswamp.org/index.php?topic=6474.0
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
	 (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)
  ;;; ===================== LOCAL FUNCTION ==========================================

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
;;;============================================================= 
;;;====================== MAIN PART ============================ 
;;;============================================================= 
  (vla-startundomark adoc)
  (setq dimz (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (setq *PREF* (mip-conv-to-str *PREF*))
  (setq *SUFF* (mip-conv-to-str *SUFF*))
  (princ "\nВведите префикс или Пробел - нет <")
  (princ *PREF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *PREF* poz))
  (if (= poz " ")(setq *PREF* ""))
  (princ "\nВведите суффикс или Пробел - нет <")
  (princ *SUFF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *SUFF* poz))
  (if (= *SUFF* " ")(setq *SUFF* ""))
  (princ "\nКратность (5 - кратно 5; 0.5 - кратно 0.5) или 0 - нет <")
  (if (numberp *ROUND*)(princ *ROUND*)(princ "НЕТ"))
  (princ ">: ")(initget 4)
  (if (null (setq poz (getdist)))
    (setq poz (if (numberp *ROUND*) *ROUND*  0))
  ) ;_ end of if
  (if (zerop poz)(setq *ROUND* nil)(setq *ROUND* poz)) ;_ end of if
  (princ "\nНачальный номер <")(princ *STARTPOZ*)(princ ">: ")
  (if (null(setq i (getint)))(setq i *STARTPOZ*)(setq *STARTPOZ* i))
  (if (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
           (princ "\nЭтап 1. Построение списка блоков.")
           (setq lstLen (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      ) ;_ end of and
    (progn
      (princ "\nЭтап 2. Анализ блоков.")
      (setq i      0
            lstLen (mapcar 'vlax-ename->vla-object lstlen)
      ) ;_ end of setq
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
          ) ;_ end of and
           (progn
             (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                       )
             ) ;_ end of if
             (setq lst
                    (cons (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9)) lst)
             ) ;_ end of setq
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (princ "... Обработано ")(princ i)(princ " блоков")
      (princ "\nЭтап 3. Построение списка из уникальных значений.")
      (setq lst (SORTSTRINGWITHNUMBERASNUMBER (RemoveDuplicateStrings lst) nil))
      (princ "\nЭтап 4. Обновление атрибутов блоков.")
      (setq i 0)
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
               (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                 ) ;_ end of setq
                 t
               ) ;_ end of if
               (setq poz (vl-position
                           (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9))
                           lst
                         ) ;_ end of vl-position
               ) ;_ end of setq
          ) ;_ end of and
           (progn
             (mip-block-setattr-bylist
               blk
               (list (cons (strcase attTo)
                           (strcat *PREF* (itoa (+ *STARTPOZ* poz)) *SUFF*)
                     ) ;_ end of cons
               ) ;_ end of list
             ) ;_ end of mip-block-setattr-bylist
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (setq *STARTPOZ* (+ *STARTPOZ* (length lst)))
      (princ "... Обновлено ")(princ i)(princ " атрибутов в блоках \n")
      (vla-regen adoc acactiveviewport)
    ) ;_ end of progn 
  ) ;_ end of if
  (setvar "DIMZIN" dimz)
  (vla-endundomark adoc)(princ)
) ;_ end of defun
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 17.04.2012, 06:25
#208
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Цитата:
Сообщение от VVA Посмотреть сообщение
Пробуй
Спасибо работает. Вот такие макросы на команды получились:
1) ^C^C_NDB;И;VP1;;ТИП;ДЛИНА;КП-; ;;1;_all;; - это для блока VP1, свойства: ТИП, ДЛИНА. Срабатывает одним нажатием.
2)^C^C_NDB;\\\;ТИП;ДЛИНА;КП-; ;;1;_all;; - это для пользовательского выбора блоков, свойства: ТИП, ДЛИНА. Выбор задал "\\\", т.е. до трех блоков. Нужно выбрать два - выбираем два блока и третий выбор любой другой объект. Как сделать красивее еще не додумался.
Еще раз спасибо, тестирую дальше.
31.07.12
Самый удобный макрос для команды. Делаем для каждого блока свой макрос:
^C^C_NDB;И;VP1;;ТИП;ДЛИНА;КП-; ;;1;\;;

Последний раз редактировалось Alex_80, 31.07.2012 в 14:20.
Alex_80 вне форума  
 
Непрочитано 02.08.2012, 15:54
#209
Alex1740


 
Регистрация: 02.08.2012
Сообщений: 1


Огромное спасибо все работает!!! Использую пример кассета.rar из 122 поста и такой макрос (^C^C_NDB;И;Кассета_v.1.6.;;Высота(H) кассеты;Ширина(B) кассеты;К; ;;1;_all ; ) . Для полного счастья нехватает только одного, чтобы уже пронумированые касеты вставить в эксель как спецификацию используя длину кассеты, ширину и маркировку, читал тему по подсчету динамических блоков, там есть похожие примеры, но со своими познаниями я немогу их привезать к данному примеру.
Alex1740 вне форума  
 
Непрочитано 27.08.2012, 11:15
#210
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Alex1740, Здесь программирование не нужно. Есть стандартная команда _dataextraction
Где можно применить "Извлечение данных"(_.dataextraction)?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 01.09.2015, 07:55 Марки блоков
#211
bear54862


 
Регистрация: 18.09.2014
Сообщений: 2


Доброго времени суток всем! I need help!! не смог до конца разобраться с маркировкой блоков ,возможно с атрибутами напутал что-то , необходима ваша помощь, поощрение гарантирую $
Вложения
Тип файла: dwg
DWG 2010
Марки блоков.dwg (1.97 Мб, 558 просмотров)
Тип файла: lsp NDB.lsp (11.7 Кб, 47 просмотров)
bear54862 вне форума  
 
Непрочитано 01.09.2015, 22:45
#212
art_rrc


 
Регистрация: 28.01.2013
Минск
Сообщений: 379


Цитата:
Сообщение от bear54862 Посмотреть сообщение
Доброго времени суток всем! I need help!! не смог до конца разобраться с маркировкой блоков ,возможно с атрибутами напутал что-то , необходима ваша помощь, поощрение гарантирую $
Так а что нужно сделать? Какой результат необходим?
art_rrc вне форума  
 
Непрочитано 02.09.2015, 05:29
#213
bear54862


 
Регистрация: 18.09.2014
Сообщений: 2


сквозную нумерацию блоков уже помогли сделать!

----- добавлено через ~2 мин. -----
спасибо VVA
bear54862 вне форума  
 
Непрочитано 26.12.2019, 15:48
#214
zloy1653


 
Регистрация: 27.11.2017
Сообщений: 24


Добрый день всем! Помогите, пожалуйста, разобраться, как в предложенном лиспе сделать нумерацию в обратном порядке, не понимаю, куда здесь нужно смотреть? Есть 2 параметра D - диаметр и L - длина, нужно сортировку сделать по 2-м свойствам, диаметр от большего к меньшему, учитывая длины, от большей к меньшей. Или в этом лиспе так не получится?

Последний раз редактировалось zloy1653, 27.12.2019 в 11:07. Причина: Сообщение можно удалить
zloy1653 вне форума  
 
Непрочитано 28.08.2020, 08:45
#215
DMSskop


 
Регистрация: 23.01.2019
Сообщений: 128


Добавьте пожалуйста выбор позиции "Имя аттрибута куда вбивать" ,а то так для разных блоков с разными именами атрибутов придется делать разные лиспы.
2) Третью позицию по которой проводить сортировку через значение атрибута.
решение тут https://forum.dwg.ru/showpost.php?p=...postcount=3924

Последний раз редактировалось DMSskop, 24.09.2020 в 09:56.
DMSskop вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Сквозная нумерация динамических блоков

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

Расширенный поиск