Макрос для измерения длины, высоты и площади фасадов, зашитых в блок

Автор Тема: Макрос для измерения длины, высоты и площади фасадов, зашитых в блок  (Прочитано 16284 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Тема содержит сообщение с Решением. Нажмите здесь чтобы посмотреть его.

Оффлайн Peacemaker_kissАвтор темы

  • ADN OPEN
  • **
  • Сообщений: 76
  • Карма: 0
  • Воспитываю из него программиста
Мое новое творение, которое измеряет длину, высоту, площадь фасада, зашитого в блок
Подход в корне был изменен, макрос претендует на критику с очень большой силой, более того имеется пару вопросов:
1. Выкладываю макрос и файл для теста, на втором проходе цикла, появляется ошибка, не могу понять почему? Если увидите, вразумите
2. На деле, я не хотел воротить кусочек кода, который открывает блок и все сплайны переделывает в полилинии, но это необходимо для выполнения строки (setq fewlines (command "_pedit" "_M" bum_set "" "_J" "_J" "_B" "100")))) по причине того, что если в bum_set попадутся сплайны то для этой команды нужно вводить переменную "precision", но в случае, если в bum_set сплайнов не обнаружится, а переменная это будет присутствовать, то автокад ругнется, дескать зачем я для отрезков и полилиний эту переменную применяю. Я думаю сделать две строки "_pedit" одну для случая со сплайнами, а другую без таковых. Идея была следующая: после того как взорван блок и  сформирован безопасный массив, который затем переконвертирован в список объектов, провести проверку списка на наличие в нем объектов типа "сплайн" и если таковые имеются, то выполнять "_pedit" с учетом сплайном, в ином случае - наоборот. Но, к своему стыду, я обнаружил, что не могу создать данное условие. Поэтому мне пришлось воротить этот ход с проникновением в блок и трансформацией сплайнов в полилинии
Так что если есть мнения -  пишите, буду признателен
Код - Auto/Visual Lisp [Выбрать]
  1. (vl-load-com)
  2. (defun c:sv_tabl (/          alltext    _textfind  _textfor   kscale     _block     _name_fas  minpoint_l maxpoint_l
  3.                   minpoint_h maxpoint_h diff_l     diff_h     _sum       _sum_sq    _visible   bum        bum_set
  4.                   bum_list   quan       fewlines   cho        num
  5.                   )
  6.   (setvar "Peditaccept" 1)
  7.   (setq _sum 0.0)
  8.   (setq _sum_sq 0.0)
  9.   (setq alltext (ssget "_X" (list (cons 1 "*00   }") (cons 0 "Mtext"))))
  10.   (setq _textfind (vlax-ename->vla-object (ssname alltext 0)))
  11.   (setq _textfor (vla-get-textstring _textfind))
  12.   (if (wcmatch _textfor "*100   }")
  13.     (setq kscale 0.01)
  14.     (setq kscale 0.02)
  15.     ) ;_ end of if
  16.   (setq _acad (vlax-get-acad-object))
  17.   (setq active_doc (vla-get-activedocument _acad))
  18.   (setq m_space (vla-get-modelspace active_doc))
  19.   (setq _blockselect (ssget "_X" (list (cons 8 "_АХП_Фасад") (cons 0 "Insert"))))
  20.   (setq counter 0)
  21.   (princ (strcat "Найдено блоков:" (rtos (sslength _blockselect) 2 0) "шт."))
  22.   (terpri)
  23.   (while (< counter (sslength _blockselect))
  24.     (setq _block (vlax-ename->vla-object (ssname _blockselect counter)))
  25.     (setq _name_fas (vla-get-effectivename _block))
  26.     (vla-getboundingbox _block 'minpoint 'maxpoint)
  27.     (setq minpoint_l (nth 0 (vlax-safearray->list minpoint)))
  28.     (setq maxpoint_l (nth 0 (vlax-safearray->list maxpoint)))
  29.     (setq minpoint_h (nth 1 (vlax-safearray->list minpoint)))
  30.     (setq maxpoint_h (nth 1 (vlax-safearray->list maxpoint)))
  31.     (setq diff_l (* kscale 10 (- maxpoint_l minpoint_l)))
  32.     (setq diff_h (* kscale 10 (- maxpoint_h minpoint_h)))
  33.     (setq l (rtos diff_l 2 1))
  34.     (princ (strcat "Длина " _name_fas ":" l "м"))
  35.     (setq _visible (vlax-invoke _block 'getdynamicblockproperties))
  36.     (nth 0 _visible)
  37.     (vla-put-value
  38.       (nth 0 _visible)
  39.       (vlax-make-variant "контур" (vlax-variant-type (vla-get-value (nth 0 _visible))))
  40.       ) ;_ end of vla-put-value
  41.     (terpri)
  42.  
  43.     (command "_.bedit" _name_fas) ;;;Входим в блок
  44.     (setq cho (ssget "_X" (list (cons 0 "Spline")))) ;;; Ищем все сплайны
  45.     (if cho ;;; если нашли сплайны
  46.       (progn (setq num (sslength cho)) ;;; определяем количество сплайнов
  47.              (repeat num (command "_.splinedit" cho "_P" "25")) ;;; преобразуем все сплайны в полилинии
  48.              (princ (strcat "Преобразовано в полилинии" (rtos num 2 0) "сплайнов")) ;;; информация о том, сколько было сплайнов преобразовано
  49.              ) ;_ end of progn
  50.       (princ "Не найдены сплайны")
  51.       ) ;_ end of if
  52.     (command "_bclose" "_s") ;;; закрываем блок
  53.  
  54.     (setq bum (vla-explode _block)) ;;; взрываем блок и получаем массив
  55.  
  56.     (setq bum_list (vlax-safearray->list (vlax-variant-value bum))) ;;; преобразуем массив в список
  57.     (setq quan (vl-list-length bum_list)) ;;; подсчитываем количетсво объектов в списке
  58.     (if (= quan 1) ;;; если количество равно 1
  59.       (progn (setq sq_a (* kscale (vlax-get-property (vlax-ename->vla-object (entlast)) 'area)))) ;;; то берем параметр площади объекта
  60.       (progn (setq ss (ssadd)) ;;; иначе формируем набор
  61.              (setq bum_set (foreach x bum_list (ssadd (vlax-vla-object->ename x) ss))) ;;; добавляем каждый элемент списка в набор
  62.  
  63.              (setq fewlines (command "_pedit" "_M" bum_set "" "_J" "_J" "_B" "100" "_X")) ;;; производим объединение всех объектов  в одну замкнутую полилинию (практика показывает, что кроме замкнутой полилинии также формируется дополнительная полиния не относящаяся к замкнутой)
  64.  
  65.              (setq sq_a (* kscale (vlax-get-property (vlax-ename->vla-object (entlast)) 'area))) ;;; определяем площадь замкнутой полилинии
  66.              (if (< sq_a 1) ;;; проверка выбра объекта, а именно замкнутой полилинии, а не дополнительной, итак если площадь < 1
  67.                (progn
  68.                   (setq sq_a (* kscale (vlax-get-property (vlax-ename->vla-object (entlast)) 'area))) ;;; то считаем площадь следующего объекта (в случае, если вначале была посчитана площадь незамкнутой линии, то будет считать замкнутой)
  69.                  ) ;_ end of progn
  70.                ) ;_ end of if
  71.              ) ;_ end of progn
  72.       ) ;_ end of if
  73.  
  74.     (princ (strcat "Площадь:" (rtos sq_a 2 1) " м2"))
  75.     (terpri)
  76.     (vla-erase (vlax-ename->vla-object (entlast)))
  77.     (setq _table (ssget "_X" (list (cons 1 (strcat "Характеристика здания (" _name_fas ") ")) (cons 0 "ACAD_TABLE"))))
  78.     (setq _t (vlax-ename->vla-object (ssname _table 0)))
  79.     (vla-settext _t 3 1 l)
  80.     (vla-settext _t 1 1 (rtos diff_h 2 1))
  81.     (vla-settext _t 2 1 (rtos sq_a 2 1))
  82.     (setq _sum (+ _sum diff_l))
  83.     (setq _sum_sq (+ _sum_sq sq_a))
  84.     (vla-put-value
  85.       (nth 0 _visible)
  86.       (vlax-make-variant "фасад" (vlax-variant-type (vla-get-value (nth 0 _visible))))
  87.       ) ;_ end of vla-put-value
  88.     (setq counter (+ counter 1))
  89.     ) ;_ end of while
  90.   (princ (strcat "\nСуммарная длина фасадов:" (rtos _sum 2 1) "м"))
  91.   (princ (strcat "\nСуммарная площадь фасадов:" (rtos _sum_sq 2 1) "м2"))
  92.   (terpri)
  93.   (setq a (rtos _sum 2 1))
  94.   (setq b (rtos _sum_sq 2 1))
  95.   (setq _tablex (ssget "_X" (list (cons 1 "Характеристика зданий") (cons 0 "ACAD_TABLE"))))
  96.   (setq _t (vlax-ename->vla-object (ssname _tablex 0)))
  97.   (vla-settext _t 2 1 a)
  98.   (vla-settext _t 1 1 b)
  99.   (setvar "Peditaccept" 0)
  100.   ) ;_ end of defun
  101.  
« Последнее редактирование: 02-12-2014, 16:39:05 от Peacemaker_kiss »

Оффлайн Peacemaker_kissАвтор темы

  • ADN OPEN
  • **
  • Сообщений: 76
  • Карма: 0
  • Воспитываю из него программиста
Сайт не даёт файл прикрепить?:(

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13886
  • Карма: 1788
  • Рыцарь ObjectARX
  • Skype: rivilis
Сайт не даёт файл прикрепить?:(
Даёт. Если он конечно не огромный.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Peacemaker_kissАвтор темы

  • ADN OPEN
  • **
  • Сообщений: 76
  • Карма: 0
  • Воспитываю из него программиста

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13886
  • Карма: 1788
  • Рыцарь ObjectARX
  • Skype: rivilis
15 мб
Можно до 8 Mb. Может нет смысла постить таких размеров файл? Или как минимум попробовать его сжать.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Peacemaker_kissАвтор темы

  • ADN OPEN
  • **
  • Сообщений: 76
  • Карма: 0
  • Воспитываю из него программиста
Для примера прикрепил небольшой файл!

Оффлайн Peacemaker_kissАвтор темы

  • ADN OPEN
  • **
  • Сообщений: 76
  • Карма: 0
  • Воспитываю из него программиста
Абсолютно ничего не понимаю, перебирал с несколькими блоками, первый проход все работает на втором спотыкается макрос и выдает нелепую ошибку в совсем странном месте!

Оффлайн Peacemaker_kissАвтор темы

  • ADN OPEN
  • **
  • Сообщений: 76
  • Карма: 0
  • Воспитываю из него программиста
Это невероятно, но я нашел ответ сам на свой первый вопрос! в конце pedit нужно ставить "_X" и все славно работает
А вот по поводу модификации макроса жду предложений
Все спсибо!


Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1116
  • Карма: 173
Скажу честно: мне не очень понятна такая дикая необходимость использования команд; зачем редактировать блок, если его потом все равно разбиваешь. И советую прочитать статью http://adn-cis.org/explode-command-and-activex.html (сначала чуть на свой сайт не отправил ;))
P.S. Критику кода примешь?
« Последнее редактирование: 01-12-2014, 21:22:40 от Алексей Кулик »
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13886
  • Карма: 1788
  • Рыцарь ObjectARX
  • Skype: rivilis
P.S. Критику кода примешь?
Он сам напросился:
Так что если есть мнения -  пишите, буду признателен
А вот по поводу модификации макроса жду предложений
:D :D :D
P.S.: Я бы начал с критики форматирования кода, ибо не смог его прочитать.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Отмечено как Решение Peacemaker_kiss 02-12-2014, 16:24:41

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1116
  • Карма: 173
У меня не с модификации, у меня с логики и общего подхода претензии :) Форматирование я уже переделал в VLIDE:
Код - Auto/Visual Lisp [Выбрать]
  1. (vl-load-com)
  2. (defun c:sv_tabl (/          alltext    _textfind  _textfor   kscale     _block     _name_fas  minpoint_l maxpoint_l
  3.                   minpoint_h maxpoint_h diff_l     diff_h     _sum       _sum_sq    _visible   bum        bum_set
  4.                   bum_list   quan       fewlines   cho        num
  5.                   )
  6.   (setvar "Peditaccept" 1)
  7.   (setq _sum 0.0)
  8.   (setq _sum_sq 0.0)
  9.   (setq alltext (ssget "_X" (list (cons 1 "*00   }") (cons 0 "Mtext"))))
  10.   (setq _textfind (vlax-ename->vla-object (ssname alltext 0)))
  11.   (setq _textfor (vla-get-textstring _textfind))
  12.   (if (wcmatch _textfor "*100   }")
  13.     (setq kscale 0.01)
  14.     (setq kscale 0.02)
  15.     ) ;_ end of if
  16.   (setq _acad (vlax-get-acad-object))
  17.   (setq active_doc (vla-get-activedocument _acad))
  18.   (setq m_space (vla-get-modelspace active_doc))
  19.   (setq _blockselect (ssget "_X" (list (cons 8 "_АХП_Фасад") (cons 0 "Insert"))))
  20.   (setq counter 0)
  21.   (princ (strcat "Найдено блоков:" (rtos (sslength _blockselect) 2 0) "шт."))
  22.   (terpri)
  23.   (while (< counter (sslength _blockselect))
  24.     (setq _block (vlax-ename->vla-object (ssname _blockselect counter)))
  25.     (setq _name_fas (vla-get-effectivename _block))
  26.     (vla-getboundingbox _block 'minpoint 'maxpoint)
  27.     (setq minpoint_l (nth 0 (vlax-safearray->list minpoint)))
  28.     (setq maxpoint_l (nth 0 (vlax-safearray->list maxpoint)))
  29.     (setq minpoint_h (nth 1 (vlax-safearray->list minpoint)))
  30.     (setq maxpoint_h (nth 1 (vlax-safearray->list maxpoint)))
  31.     (setq diff_l (* kscale 10 (- maxpoint_l minpoint_l)))
  32.     (setq diff_h (* kscale 10 (- maxpoint_h minpoint_h)))
  33.     (setq l (rtos diff_l 2 1))
  34.     (princ (strcat "Длина " _name_fas ":" l "м"))
  35.     (setq _visible (vlax-invoke _block 'getdynamicblockproperties))
  36.     (nth 0 _visible)
  37.     (vla-put-value
  38.       (nth 0 _visible)
  39.       (vlax-make-variant "контур" (vlax-variant-type (vla-get-value (nth 0 _visible))))
  40.       ) ;_ end of vla-put-value
  41.     (terpri)
  42.  
  43.     (command "_.bedit" _name_fas)
  44.     (setq cho (ssget "_X" (list (cons 0 "Spline"))))
  45.     (if cho
  46.       (progn (setq num (sslength cho))
  47.              (repeat num (command "_.splinedit" cho "_P" "25"))
  48.              (princ (strcat "Преобразовано в полилинии" (rtos num 2 0) "сплайнов"))
  49.              ) ;_ end of progn
  50.       (princ "Не найдены сплайны")
  51.       ) ;_ end of if
  52.     (command "_bclose" "_s")
  53.  
  54.     (setq bum (vla-explode _block))
  55.  
  56.     (setq bum_list (vlax-safearray->list (vlax-variant-value bum)))
  57.     (setq quan (vl-list-length bum_list))
  58.     (if (= quan 1)
  59.       (progn (setq sq_a (vlax-get-property (vlax-ename->vla-object (entlast)) 'area)))
  60.       (progn (setq ss (ssadd))
  61.              (setq bum_set (foreach x bum_list (ssadd (vlax-vla-object->ename x) ss)))
  62.  
  63.              (setq fewlines (command "_pedit" "_M" bum_set "" "_J" "_J" "_B" "100" "_X"))
  64.  
  65.              (setq sq_a (* kscale (vlax-get-property (vlax-ename->vla-object (entlast)) 'area)))
  66.              (if (< sq_a 1)
  67.                (progn
  68.  
  69.                  (setq sq_a (* kscale (vlax-get-property (vlax-ename->vla-object (entlast)) 'area)))
  70.                  ) ;_ end of progn
  71.                ) ;_ end of if
  72.              ) ;_ end of progn
  73.       ) ;_ end of if
  74.  
  75.     (princ (strcat "Площадь:" (rtos sq_a 2 1) " м2"))
  76.     (terpri)
  77.     (vla-erase (vlax-ename->vla-object (entlast)))
  78.     (setq _table (ssget "_X" (list (cons 1 (strcat "Характеристика здания (" _name_fas ") ")) (cons 0 "ACAD_TABLE"))))
  79.     (setq _t (vlax-ename->vla-object (ssname _table 0)))
  80.     (vla-settext _t 3 1 l)
  81.     (vla-settext _t 1 1 (rtos diff_h 2 1))
  82.     (vla-settext _t 2 1 (rtos sq_a 2 1))
  83.     (setq _sum (+ _sum diff_l))
  84.     (setq _sum_sq (+ _sum_sq sq_a))
  85.     (vla-put-value
  86.       (nth 0 _visible)
  87.       (vlax-make-variant "фасад" (vlax-variant-type (vla-get-value (nth 0 _visible))))
  88.       ) ;_ end of vla-put-value
  89.     (setq counter (+ counter 1))
  90.     ) ;_ end of while
  91.   (princ (strcat "\nСуммарная длина фасадов:" (rtos _sum 2 1) "м"))
  92.   (princ (strcat "\nСуммарная площадь фасадов:" (rtos _sum_sq 2 1) "м2"))
  93.   (terpri)
  94.   (setq a (rtos _sum 2 1))
  95.   (setq b (rtos _sum_sq 2 1))
  96.   (setq _tablex (ssget "_X" (list (cons 1 "Характеристика зданий") (cons 0 "ACAD_TABLE"))))
  97.   (setq _t (vlax-ename->vla-object (ssname _tablex 0)))
  98.   (vla-settext _t 2 1 a)
  99.   (vla-settext _t 1 1 b)
  100.   (setvar "Peditaccept" 0)
  101.   ) ;_ end of defun
Пока подожду реакции автора ;)
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Peacemaker_kissАвтор темы

  • ADN OPEN
  • **
  • Сообщений: 76
  • Карма: 0
  • Воспитываю из него программиста

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

Оффлайн Peacemaker_kissАвтор темы

  • ADN OPEN
  • **
  • Сообщений: 76
  • Карма: 0
  • Воспитываю из него программиста
P.S.: Я бы начал с критики форматирования кода, ибо не смог его прочитать.
Алексей отформатировал, я примечания выполнил к макросу, очень жду критики!!!!! Учиться хочу!!!!!

Оффлайн Peacemaker_kissАвтор темы

  • ADN OPEN
  • **
  • Сообщений: 76
  • Карма: 0
  • Воспитываю из него программиста
P.S. Критику кода примешь?
Не то слово, почту за честь

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1116
  • Карма: 173
Ок, погнали :) Перечислил то, что увидел. Возможно, еще наберется ;)
1. Нет меток начала и конца отмены.
2. Не обрабатываются варианты блокирования / заморозки слоев
3. Ты абсолютно уверен, что текст с указанием масштаба будет один? А если не один, то первый гарантированно указывает на масштаб (забудем про то, что чертить в ACAD с масштабом - вообще нонсенс, ну да ладно)?
4. Ты уверен, что в дин.блоке фасада обязательно будет видимость "Контур"?
5. vla-explode возвращает variant-массив получившихся объектов. Преобразовывай в список и обрабатывай.
6. Не возвращается обратно видимость обработанного блока
7. Ты слишком уверен, что таблица опять же:
а) существует в файле
б) она именно такого вида, как должно быть
в) и она только одна.
8. Ты так лихо устанавливаешь peditaccept в 1... А если у пользователя она была установлена в 0?
9. Ты с легкостью используешь splinedit, но напрочь забыл про plineconvertmode и delobj.
10. Нет обработчика ошибок (ну это так, до кучи)
11. pedit в твоем варианте, думаю, можно будет заменить чисто программной обработкой: получить координаты каждой полилинии, при необходимости выполнить реверс (см. pltools с dwg.ru), на их основе построить новую полилинию и забрать с нее площадь. Или набор сплайнов / полилиний преобразовать в Region, получить площадь и удалить созданный объект.

P.S. Я думал было написать код, но времени не хватило. А показывать сырые поделки (которые вдобавок не работают) - никуда не годится. Так что все "насухую".
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!