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

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

Функция чтения свойств и их значений динамического блока

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 10.08.2014, 18:44 1 | #1
Функция чтения свойств и их значений динамического блока
Supermax
 
Руководитель фирмы
 
Москва
Регистрация: 28.03.2007
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™

Supermax вне форума Вставить имя

Написано коряво, но работает.
Работает с любым количеством visibility-set-ов.
Буду благодарен за советы по модификации или посильную помощь в этом.

Код:
[Выделить все]
 ;========== Функция получения свойств и их значений динамического блока =============================================
; в переменную s_3 записан список видимых свойств и их значений
;Пример: (dinamik_block_property (car (entsel)))
(defun dinamik_block_property ( blk_input / r_e r_w prop_block lst_name_block dxf_slov_block slov_block wq-w_block wq-w_block lst_dict BLC-VIS-PAR r_u current_value_property_vis n_1 n_2 n_3 g_1 g_2 g_3 g_4 g_5)
(if (= (type blk_input) 'ENAME) (setq blk_input (vlax-ename->vla-object blk_input)))

;=== проверяем блок на вшивость, то есть динамический он или нет? =========================================
; заодно сохраняем в r_e список всех свойств блока, а в r_w - список видимых свойств блока
(setq r_w nil)
(mapcar (function (lambda (x) (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-safearray->list (list (setq r_e (vlax-variant-value 
  (vlax-invoke-method x "GetDynamicBlockProperties") ) ) ) ) ) )
(setq r_w (append (vl-remove-if (function (lambda (x) (= (vla-get-Show x) :vlax-false))) (vlax-safearray->list r_e)) r_w)))
))  (list blk_input))

;==========  получаем словарь "ACAD_EVALUATION_GRAPH" =============================================
; указатель на него записан в lst_dict
(defun prop_block ( blk-1 / )
;Находим эффективное имя блока и по нему находим в базе блоков его полное описание
(setq lst_name_block (entget (TBLOBJNAME "block" (vla-get-EffectiveName blk-1)) '("*")))
(setq slov_block (cdr (assoc 330 lst_name_block)))  ;Выбираем словарь со свойствами этого блока
(setq dxf_slov_block (entget slov_block))  ;Получаем список DXF-кодов этого словаря
(setq wq-w_block (entget (cdr (assoc 360 dxf_slov_block)))) ;Выбираем из этого списка словарь и получаем его DXF-коды
;Получаем содержание словаря со свойствами блока и их DXF-сопровождением
(setq lst_dict (car (mapcar 'cdr (vl-remove-if-not '(lambda(x) 
  (and (= (car x) 360) (= (cdr (assoc 0 (entget (cdr x)))) "ACAD_EVALUATION_GRAPH"))) wq-w_block))))
)

(prop_block blk_input)

;======== определяем, есть параметры visibility-set или нет? ==============================================
; если visibility-set-ы есть, то в переменную BLC-VIS-PAR записаны на них указатели. В 301 пару записаны их имена
(setq BLC-VIS-PAR nil)
(if lst_dict (mapcar '(lambda (x) 
  (if (and (= (car x) 360) 
           (= (cdr (assoc 0 (entget (cdr x)))) "BLOCKVISIBILITYPARAMETER"))
      (setq BLC-VIS-PAR (cons (cdr x) BLC-VIS-PAR) ) )) (entget lst_dict)))

;======== если параметров visibility-set нет, то есть BLC-VIS-PAR = nil =======================================
; то переменная r_w содержит окончательный список видимых свойств 
(setq r_u nil)
(if (null r_w) (mapcar (function (lambda (x) 
(setq r_u (cons (list (vla-get-PropertyName x) (vlax-variant-value (vla-get-Value x))) r_u))
))
r_w))
(mapcar (function (lambda (x) (if (= (vl-prin1-to-string (type (cadr x))) "safearray") (setq r_u (subst (cons (car x) (vlax-safearray->list (cadr x))) x r_u))))) r_u)

;============ функция получения списка текущих видимых свойсв представления visibility-set =====================================

(defun current_value_property_vis ( name vis / )
; name - строка, имя текущего представления "BLOCKVISIBILITYPARAMETER"
; vis -  указатель на "BLOCKVISIBILITYPARAMETER"
(setq n_1 (member (cons 303 name) (entget vis)))
(setq n_1 (member (assoc 333 n_1) n_1))
(setq n_3 nil)
(vl-member-if-not  (function (lambda (x) (if (= (car x) 333) (setq n_3 (cons (cdr x) n_3)) ) )) n_1)
); end defun 

;============ функция получения окончательного списка свойств =========================================

(defun current_property ( spis / )

;Сначала получаем список видимых visibility-set-ов, поскольку они тоже могут быть видимы в списке свойств блока
(setq spis-zz nil)
(mapcar '(lambda (tx) (if (setq ii-ii (vl-member-if (function (lambda (tt) (= (cdr (assoc 301 (entget tx))) (vla-get-PropertyName tt)) )) r_w)) (setq spis-zz (cons (car ii-ii) spis-zz)))
) spis)
(if spis-zz (setq spis-rr (mapcar (function (lambda (yu) (list (vla-get-PropertyName yu) (vlax-variant-value (vla-get-Value yu))))) spis-zz)))
;В spis-rr записаны пары (наименование-значение) видимых параметров visibility-set и их текущих состояниях представлений

; получаем имя первого visibility-set
(setq g_1 (cdr (assoc 301 (entget (car spis)))))
; получаем текущее представление первого visibility-set
(mapcar (function (lambda (x) (if (= (vla-get-PropertyName x) g_1) (setq g_2 (vlax-variant-value (vla-get-Value x))) ) ))
(vlax-safearray->list r_e))
; получаем список свойтв первого visibility-set
(current_value_property_vis g_2 (car spis))
(setq g_3 n_3) 
; укорачиваем список с visibility-set-ами
(setq g_4 (cdr spis))
(setq g_5 nil)

(if g_4 (mapcar (function (lambda (x) 

(mapcar (function (lambda (z) (if (= (vla-get-PropertyName z) (cdr (assoc 301 (entget x)))) (setq g_2 (vlax-variant-value (vla-get-Value z))) ) ))
(vlax-safearray->list r_e))

(current_value_property_vis g_2 x)

(setq g_5 nil)
(mapcar (function (lambda (y) 
(if (vl-position y n_3) (setq g_5 (cons y g_5)))))
g_3)

(setq g_3 g_5)
))
g_4)
) 

(setq g_6 nil)
(mapcar '(lambda (d) 
(if (wcmatch (cdr (assoc 0 (entget d))) "*PARAMETER") (setq g_6 (cons d g_6)))
)
g_3)
)

(if BLC-VIS-PAR (current_property BLC-VIS-PAR))

;==============================================================================================

(setq s_2 nil)
(if g_6 (mapcar '(lambda (p)
(setq s_2 (cons (cdr (assoc 303 (entget p))) s_2))
(setq s_2 (cons (cdr (assoc 305 (entget p))) s_2))
)
g_6))

(setq s_2 (vl-remove-if 'null s_2))
(if s_2 (setq s_2 (mapcar '(lambda (x) (vl-string-subst "O" (vl-registry-read "HKEY_CURRENT_USER\\LISP" "diametr") x)) s_2)))


(setq s_3 nil)
(if s_2 (mapcar (function (lambda (x) (if (vl-member-if '(lambda (h) (= (vla-get-PropertyName x) h)) s_2) 
  (setq s_3 (cons 
(list 
(vla-get-PropertyName x) 
(if (= (get_tile "bd1") "1") (strcat (vla-get-Description x)
(if (/= (type (vlax-variant-value (vla-get-Value x))) STR)  
(vl-princ-to-string (vlax-variant-value (vla-get-Value x))) (vlax-variant-value (vla-get-Value x))
))
(if (/= (type (vlax-variant-value (vla-get-Value x))) STR)  
(vl-princ-to-string (vlax-variant-value (vla-get-Value x))) (vlax-variant-value (vla-get-Value x))
)
)
) s_3)))))
r_w))

(setq s_3 (mapcar '(lambda (l) (list (vl-string-trim " " (car l)) (cadr l)) ) s_3))
(setq s_3 (append s_3 spis-rr));Соединяем списки свойств и параметров visibility-set

)

Вложения
Тип файла: lsp Получение свойств динамического блока.lsp (6.4 Кб, 85 просмотров)


Последний раз редактировалось Supermax, 19.08.2014 в 15:23.
Просмотров: 4631
 
Автор темы   Непрочитано 17.08.2014, 20:14
#2
Supermax

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


Немного подправил. Если кто заинтересовался - замените у себя.
Тут сами visibility-set-ы не обрабатываются. Позже добавлю.
Supermax вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 17.08.2014, 20:31
#3
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,520
Отправить сообщение для gomer с помощью ICQ Отправить сообщение для gomer с помощью Skype™


Supermax, Думаешь эта каша может заинтересовать? Ну посмотри ты хотя б в соседних ветках, как оформляют функции на публику
Добавь лисп файл для скачивания, ибо копипастить - та еще морока
gomer вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 18.08.2014, 23:09
#4
Supermax

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


Файл добавлю. Сейчас ещё чуток усовершенствую и добавлю.
Лиспы оформленные лесенкой - ненавижу. У меня матричное сознание. Чем больше я вижу кода, тем мне легче понимать его работу. Лесенку сами стройте.
Если кому-то интересен алгоритм, то готов обсудить. А если надо просто пользоваться, так в fas перегоните и зрительные нервы не раздражайте.

----- добавлено через ~16 ч. -----
Всё. Теперь всё обрабатывается. Файл добавил.
Supermax вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 26.08.2014, 07:32
#5
AndruxaZ


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


Пробовал код - выдаёт ошибку.
Команда: (dinamik_block_property (car (entsel)))
Выберите объект: ; ошибка: неверный тип аргумента: (or stringp symbolp): nil

Пробовал на разных блоках. Скачивал файл отсюда http://forum.dwg.ru/showpost.php?p=288818&postcount=41, тоже самое.
Если что то - система Win7 x32, Autocad 2010rus, СПДС 8.1
AndruxaZ вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 26.08.2014, 08:39
#6
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,225


Аналогично.

Цитата:
Команда: (dinamik_block_property (car (entsel)))

Выберите объект: ; ошибка: неверный тип аргумента: (or stringp symbolp): nil
Win7 x64, Autocad 2014 SP1 rus

----- добавлено через ~27 мин. -----

PS
Supermax, покопайся здесь.
Код:
[Выделить все]
(if s_2 
 (setq s_2 
  (mapcar '(lambda (x) (vl-string-subst "O" (vl-registry-read "HKEY_CURRENT_USER\\LISP" "diametr") x)) s_2)
  )
)

Последний раз редактировалось Makswell, 26.08.2014 в 09:08.
Makswell вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 07.09.2014, 11:19
#7
Supermax

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


Всё правильно. Я забыл этот момент осветить.
Дело в том, что лисп пишется как правило в ANSI-кодировке, а там невозможно вставить и выполнить замену символа в кодировке Юникод.
https://ru.wikipedia.org/wiki/Ø
А в наименовании свойств я часто использую этот символ Ø вместо знака диаметра, который упорно не хочет отображаться. Вот и приходится выкручиваться через реестр. Я создал там ветку и разместил этот символ. Теперь я вызываю его и меняю на простое О. Отказаться от использования его не могу.
Просто скопируйте в командную строку этот код:
Код:
[Выделить все]
 (vl-registry-write "HKEY_CURRENT_USER\\LISP" "diametr" "Ø")
и будет вам счастье.
Supermax вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 07.09.2014, 12:05
#8
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,520
Отправить сообщение для gomer с помощью ICQ Отправить сообщение для gomer с помощью Skype™


Разве сейчас автокад не поддерживает Юникод ?
gomer вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 07.09.2014, 14:47
#9
Supermax

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


Тут очень странное дело с этой поддержкой. Вставлять разрешает, но если читать свойства через метод GetDynamicBlockProperties, то Автокад автоматически заменяет Юникод на Анси. Вместо перечёркнутого О пишет простое заглавное. Вот и приходится приспосабливаться при проверке.
Supermax вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Библиотека функций > Функция чтения свойств и их значений динамического блока

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

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

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

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужна функция импорта блока из файла Krieger Программирование 20 18.01.2017 07:19
Назначение свойств атрибутов блока без attsync Кулик Алексей aka kpblc Программирование 7 27.08.2015 15:03
VBA функция InsertBlock для динамического блока - не правильно воспринимает параметр sergtranes Программирование 2 14.02.2011 19:33
VBA функция InsertBlock для динамического блока - проблема sergtranes Программирование 4 11.02.2011 12:54

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


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