Get Adobe Flash player
dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP. Нормализация блоков текущего файла.

LISP. Нормализация блоков текущего файла.

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 09.06.2008, 10:30 8 | 1
LISP. Нормализация блоков текущего файла.
Кулик Алексей aka kpblc
Moderator
 
LISP, C# (ACAD 200[9,12,13,14])
 
С.-Петербург
Регистрация: 25.08.2003
Сообщений: 34,278

Кулик Алексей aka kpblc вне форума Вставить имя

Небольшая вспомогательная программа по "нормализации блоков" текущего файла.
Пример вызова:
(norm-blocks bit)
Аргументы вызова:
  1. bit сумма любого количества следующих значений:
    • 1 ; слой объекта - "0"
    • 2 ; тип линии объекта - ByBlock
    • 4 ; вес линии объекта - ByBlock
    • 8 ; цвет линии объекта - ByBlock
    • 16 ; масштаб линии объекта - 1
    • nil или <1 - выход из программы
Код:
[Выделить все]
(norm-blocks 1)	; перевести все объекты всех блоков в слой "0", не меняя остальные
  ; настройки
(norm-blocks 2)	; изменить тип линий всех объектов всех блоков на "ByBlock", не
  ; меняя остальных свойств
(norm-blocks 7) ; изменить слой на "0" (1), тип линиии - на ByBlock (2); вес линии - на
  ; ByBlock (4)

Вложения
Тип файла: lsp norm-blocks.lsp (5.8 Кб, 2902 просмотров)
Тип файла: lsp norm-blocks_v3.lsp (5.8 Кб, 1135 просмотров)

__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.

Последний раз редактировалось Кулик Алексей aka kpblc, 12.11.2014 в 11:34.
Просмотров: 46649
 
Автор темы   Непрочитано 05.04.2010, 00:44
#41
Кулик Алексей aka kpblc
Moderator

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


Исправил #34
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 05.04.2010, 03:09
#42
АлексЮстасу

топограф, технолог
 
Регистрация: 24.05.2009
Москва
Сообщений: 2,506


Что-то в последней версии norm-blocks-with-explode у меня не только веса не меняются с ByLayer на ByBlock, но и типы линий остаются ByLayer, и слои остаются как были.
Меняется только разбиваемость.
И когда задаю (norm-blocks-with-explode 2 nil), т.е. изменять тип линий всех объектов всех блоков на "ByBlock".
И когда задаю (norm-blocks-with-explode 4 nil), ), т.е. изменять веса всех объектов всех блоков на "ByBlock".
И когда задаю (norm-blocks-with-explode 7 t), т.е. изменить слой на "0" (1), тип линиии - на ByBlock (2); вес линии - на ByBlock (4).

Можно добавть статистику - сколько блоков обработано. Чтобы сразу было понятно, что программа работала, т.к. при малом числе блоков все происходит так быстро, что непонятно - работала вообще или нет.

Последний раз редактировалось АлексЮстасу, 05.04.2010 в 03:14.
АлексЮстасу вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 05.04.2010, 13:39
1 | #43
Кулик Алексей aka kpblc
Moderator

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


Нда, что-то у меня вчерась совсем не соображалось...
Попробуй так:
Код:
[Выделить все]
(defun norm-blocks-with-explode (bit               explode           /                 loc_bit
                                 adoc              *error*           fun_conv-vla-to-list
                                 fun_layer-save    fun_layer-restore lst_layer         fun_get-ent-name
                                 fun_property-set
                                 )
                                ;|
*    Нормализация блоков текущего файла.
*    Аргументы вызова:
	bit	сумма любого количества следующих значений:
	  1   ; слой объекта - "0"
	  2   ; тип линии объекта - ByBlock
	  4   ; вес линии объекта - ByBlock
	  8   ; цвет линии объекта - ByBlock
	  16  ; масштаб линии объекта - 1
	  nil или <1 - выход из программы
	explode	для всех блоков установить "разбиваемость". t -> установить
		nil -> снять
*    Примеры вызова:
(norm-blocks-with-explode 1 t)	; перевести все объекты всех блоков в слой "0", не меняя остальные
  ; настройки. Установить блоки "разбиваемыми"
(norm-blocks-with-explode 2 nil)	; изменить тип линий всех объектов всех блоков на "ByBlock", не
  ; меняя остальных свойств. Снять "разбиваемость" блоков
(norm-blocks-with-explode 7 t) ; изменить слой на "0" (1), тип линиии - на ByBlock (2); вес линии - на
  ; ByBlock (4). Установить блоки разбиваемыми
|;

  (defun *error* (msg)
    (fun_layer-restore (lst_layer))
    (vla-regen adoc acallviewports)
    (vla-endundomark adoc)
    (princ)
    ) ;_ end of defun

  (defun fun_get-attr (blk-ref)
    (append (fun_conv-vla-to-list (vla-getattributes blk-ref))
            (fun_conv-vla-to-list (vla-getconstantattributes blk-ref))
            ) ;_ end of append
    ) ;_ end of defun

  (defun fun_conv-vla-to-list (value / res)
    (cond
      ((= (type value) 'variant)
       (setq res (fun_conv-vla-to-list (vlax-variant-value value)))
       )
      ((and (= (type value) 'safearray)
            (>= (vlax-safearray-get-u-bound value 1) 0)
            ) ;_ end of and
       (setq res (vlax-safearray->list value))
       )
      ((and (= (type value) 'safearray)
            (< (vlax-safearray-get-u-bound value 1) 0)
            ) ;_ end of and
       (setq res nil)
       )
      (t
       (if (vlax-property-available-p value 'count)
         (setq res ((lambda (/ lst)
                      (vlax-for item value
                        (setq lst (cons item lst))
                        ) ;_ end of vlax-for
                      (reverse lst)
                      ) ;_ end of lambda
                    )
               ) ;_ end of setq
         (setq res (list value))
         ) ;_ end of if
       )
      ) ;_ end of cond
    res
    ) ;_ end of defun

  (defun fun_get-ent-name (ent)
    (cond
      ((vlax-property-available-p ent 'effectivename)
       (vla-get-effectivename ent)
       )
      ((vlax-property-available-p ent 'name)
       (vla-get-name ent)
       )
      (t nil)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun fun_layer-save (/ res)
    (setq res (mapcar '(lambda (x)
                         (list x
                               (cons "freeze" (vla-get-freeze x))
                               (cons "lock" (vla-get-lock x))
                               ) ;_ end of list
                         ) ;_ end of lambda
                      (vl-remove-if
                        '(lambda (a)
                           (wcmatch (fun_get-ent-name a) "*|*")
                           ) ;_ end of lambda
                        (fun_conv-vla-to-list (vla-get-layers adoc))
                        ) ;_ end of vl-remove-if
                      ) ;_ end of mapcar
          ) ;_ end of setq
    (foreach item lst
      (fun_property-set item "freeze" :vlax-false)
      (fun_property-set item "lock" :vlax-false)
      ) ;_ end of foreach
    res
    ) ;_ end of defun

  (defun fun_layer-restore (lst)
    (foreach item lst
      (foreach prop (cdr item)
        (fun_property-set (car item) (car prop) (cdr prop))
        ) ;_ end of foreach
      ) ;_ end of foreach
    ) ;_ end of defun

  (defun fun_property-set (ent prop value)
    (if (vlax-property-available-p ent prop)
      (vl-catch-all-apply '(lambda () (vlax-put-property ent prop value)))
      ) ;_ end of if
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if (and bit
           (>= bit 1)
           ) ;_ end of and
    (progn
      (setq lst_layer (fun_layer-save)
            explode   (if explode
                        :vlax-true
                        :vlax-false
                        ) ;_ end of if
            loc_bit   bit
            ) ;_ end of setq
      (foreach blk_def
               (vl-remove-if
                 (function
                   (lambda (x)
                     (or
                       (equal (vla-get-islayout x) :vlax-true)
                       (equal (vla-get-isxref x) :vlax-true)
                       (wcmatch
                         (strcase (vla-get-name x))
                         ",_DOT,_DOTSMALL,_DOTBLANK,_ORIGIN,_ORIGIN2,_OPEN,_OPEN90,_OPEN30,_CLOSED,_SMALL,_NONE,_OBLIQUE,_BOXFILLED,_BOXBLANK,_CLOSEDBLANK,_DATUMFILLED,_DATUMBLANK,_INTEGRAL,_ARCHTICK"
                         ) ;_ end of wcmatch
                       ) ;_ end of or
                     ) ;_ end of lambda
                   ) ;_ end of function
                 (fun_conv-vla-to-list (vla-get-blocks adoc))
                 ) ;_ end of vl-remove-if
        (if (vlax-property-available-p blk_def 'explodable t)
          (vla-put-explodable blk_def explode)
          ) ;_ end of if
        (vlax-for sub blk_def
          (setq bit loc_bit)
          (if (>= bit 16)
            (progn
              (fun_property-set sub 'color 0)
              (setq bit (- bit 16))
              ) ;_ end of progn
            ) ;_ end of if
          (if (>= bit 8)
            (progn
              (fun_property-set sub 'linetypescale 1.)
              (setq bit (- bit 8))
              ) ;_ end of progn
            ) ;_ end of if
          (if (>= bit 4)
            (progn
              (fun_property-set sub 'lineweight aclnwtbyblock)
              (setq bit (- bit 4))
              ) ;_ end of progn
            ) ;_ end of if
          (if (>= bit 2)
            (progn
              (fun_property-set sub 'linetype "byblock")
              (setq bit (- bit 2))
              ) ;_ end of progn
            ) ;_ end of if
          (if (>= bit 1)
            (progn
              (fun_property-set sub 'layer "0")
              (setq bit (1- bit))
              ) ;_ end of progn
            ) ;_ end of if
          ) ;_ end of vlax-for
        ) ;_ end of foreach
      ;; В принципе, следующий цикл не особо требуется, но я оставил
      (foreach ent (fun_conv-vla-to-list (vla-get-blocks adoc))
        (vlax-for sub ent
          (vl-catch-all-apply '(lambda () (vla-update sub)))
          ) ;_ end of vlax-for
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (fun_layer-restore lst_layer)
  (vla-regen adoc acallviewports)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 05.04.2010, 14:16
#44
АлексЮстасу

топограф, технолог
 
Регистрация: 24.05.2009
Москва
Сообщений: 2,506


Работает, делает, хотя и статистику не выдает
АлексЮстасу вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.11.2010, 13:27
#45
Kserg_nn


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


пожалуйста подскажите как ее правильно запустить в 2010 автокаде?
norm-blocks
_norm-blocks
ничего не помогает(

пишет ошибку "ошибка: слишком мало аргументов"
Kserg_nn вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.11.2010, 17:32
#46
АлексЮстасу

топограф, технолог
 
Регистрация: 24.05.2009
Москва
Сообщений: 2,506


Цитата:
Сообщение от Kserg_nn Посмотреть сообщение
пожалуйста подскажите как ее правильно запустить в 2010 автокаде?
norm-blocks
_norm-blocks
ничего не помогает(

пишет ошибку "ошибка: слишком мало аргументов"
Вы и не указали аргументы.

См. в лиспе, в его начале "Аргументы вызова", "Примеры вызова" - в первом посте, в посте #43.
АлексЮстасу вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 17.11.2010, 09:49
#47
Kserg_nn


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


с этим разобрался я просто скобки не писал, а без них пробел нельзя поставить), но все равно это не то что мне нужно
не нужно чтоб элемент блока помещались именно в слой где лежит сам блок! причем так чтоб блоки можно было выбирать
Kserg_nn вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 17.11.2010, 10:18
#48
Лиспер


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


Нереально.
__________________
(/= RegDate StartReadDate)
Лиспер вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 17.11.2010, 11:22
#49
Kserg_nn


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


очень жаль(
даже без выбора блоков не реально? пусть все массово переносятся
Kserg_nn вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 17.11.2010, 11:25
#50
Лиспер


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


Проблема не в этом. Есть блок с именем "Блок1", у него 2 вхождения - одно на слой "Слой1", с цветом ПоСлою, весом линии 0,50, типом линии Dashed; второе - на слое "Слой123", цвет красный, вес линии ПоСлою, тип линии Continuous. Какие настройки должны получить примитивы описания блока?
__________________
(/= RegDate StartReadDate)
Лиспер вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 17.11.2010, 13:32
#51
Kserg_nn


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


устроило бы если бы было так: цвет, вес, тип линии - "по слою"
Kserg_nn вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 17.11.2010, 13:58
#52
Лиспер


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


Для этого внутри блока достатчно сделать все ПоБлоку
__________________
(/= RegDate StartReadDate)
Лиспер вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 17.11.2010, 15:38
#53
Kserg_nn


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


я не могу войти в блок, да и ходить в каждый (если их много) особого удовольствия нет
Kserg_nn вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 17.11.2010, 15:43
#54
Лиспер


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


Вообще-то именно для того, чтобы не заходить в каждый блок, и сделана эта программа.
__________________
(/= RegDate StartReadDate)
Лиспер вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 17.11.2010, 16:25
#55
Kserg_nn


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


но она в "0" все приводит, мне так не надо же
Kserg_nn вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 17.11.2010, 22:57
#56
Кулик Алексей aka kpblc
Moderator

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


Я советую создать несколько блоков с разными настройками примитивов, повставлять их на разные слои и потом разбить. И проанализировать результаты.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 19.11.2010, 10:34
#57
Kserg_nn


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


хорошо, спасибо
Kserg_nn вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 26.07.2011, 17:58
#58
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,427


аналог от manusoft.com

Код:
[Выделить все]
  ;FixBlock.lsp  [June 30, 1998]
 ;
 ; Copyright 1996 - 1998 ManuSoft
 ;
 ; Freeware from:
 ;   ManuSoft
 ;   http://www.manusoft.com
 ;
 ; Load function, then enter FIXBLOCK to redefine selected blocks
 ;  so that all entities are on layer '0', color 'BYBLOCK'.
 ;


(defun C:FixBlock (/ ss cnt idx blkname donelist Grp Update)
  (defun Grp (gc el) (cdr (assoc gc el)))
  (defun Update (bname / ename elist)
    (setq ename (tblobjname "BLOCK" bname))
    (if
      (and ename (zerop (logand 52 (Grp 70 (entget ename '("*"))))))
      (progn
        (while ename
          (setq elist (entget ename '("*"))
                elist (subst '(8 . "0") (assoc 8 elist) elist)
                elist (if (assoc 62 elist)
                        (subst '(62 . 0) (assoc 62 elist) elist)
                        (append elist '((62 . 0)))))
          (entmake elist)
          (setq ename (entnext ename)))
        (if (/= "ENDBLK" (Grp 0 elist))
          (entmake '((0 . "ENDBLK") (8 . "0") (62 . 0))))
        'T))
  )
  (if (> (logand (Grp 70 (tblsearch "layer" "0")) 1) 0)
    (princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
    (progn
      (if
        (progn
          (princ "\nPress <Enter> to fix all defined blocks\n")
          (setq cnt 0
                ss (ssget '((0 . "INSERT")))))
        (progn
          (setq idx (sslength ss))
          (while (>= (setq idx (1- idx)) 0)
            (if (not (member (setq blkname (Grp 2 (entget (ssname ss idx)))) donelist))
              (progn
                (if (Update blkname) (setq cnt (1+ cnt)))
                (setq donelist (cons blkname donelist))))))
        (while (setq blkname (Grp 2 (tblnext "BLOCK" (not blkname))))
          (if (Update blkname) (setq cnt (1+ cnt)))))
      (princ (strcat "\n" (itoa cnt) " block" (if (= cnt 1) "" "s") " redefined\n"))))
  (princ)
)
;End-of-file
Nike на форуме вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 22.08.2012, 19:14
#59
zerg_od


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


Можно добавить чтобы менялся ещё и цвет линии объекта - на ByBlock. Предусмотрено ли редактирование атрибутов блока.
zerg_od вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 23.08.2012, 09:28
#60
VVA

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


zerg_od,
BGBLFIX - Нормализация блоков
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP. Нормализация блоков текущего файла.

Опции темы Поиск в этой теме
Поиск в этой теме:

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

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Lisp. Расстановка блоков на пересечении линий. wetr LISP 21 25.12.2014 15:27
Импорт палитры блоков при помощи LISP TwoZero LISP 11 27.01.2013 22:35
AutoCAD 2008 - вставка блоков из файла в файл Vavan Metallist AutoCAD 14 25.05.2009 19:37
Удаление не используемых блоков из файла Гузалия AutoCAD 3 13.12.2007 10:06
2008. Глюк с назначением текущего цвета из Lisp? _Andre_ LISP 5 25.10.2007 13:50

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||


Размещение рекламы