ADN Club > AutoLisp / VisualLISP и DCL
Макрос для измерения длины, высоты и площади фасадов, зашитых в блок
Peacemaker_kiss:
Мое новое творение, которое измеряет длину, высоту, площадь фасада, зашитого в блок
Подход в корне был изменен, макрос претендует на критику с очень большой силой, более того имеется пару вопросов:
1. Выкладываю макрос и файл для теста, на втором проходе цикла, появляется ошибка, не могу понять почему? Если увидите, вразумите
2. На деле, я не хотел воротить кусочек кода, который открывает блок и все сплайны переделывает в полилинии, но это необходимо для выполнения строки (setq fewlines (command "_pedit" "_M" bum_set "" "_J" "_J" "_B" "100")))) по причине того, что если в bum_set попадутся сплайны то для этой команды нужно вводить переменную "precision", но в случае, если в bum_set сплайнов не обнаружится, а переменная это будет присутствовать, то автокад ругнется, дескать зачем я для отрезков и полилиний эту переменную применяю. Я думаю сделать две строки "_pedit" одну для случая со сплайнами, а другую без таковых. Идея была следующая: после того как взорван блок и сформирован безопасный массив, который затем переконвертирован в список объектов, провести проверку списка на наличие в нем объектов типа "сплайн" и если таковые имеются, то выполнять "_pedit" с учетом сплайном, в ином случае - наоборот. Но, к своему стыду, я обнаружил, что не могу создать данное условие. Поэтому мне пришлось воротить этот ход с проникновением в блок и трансформацией сплайнов в полилинии
Так что если есть мнения - пишите, буду признателен
--- Код - Auto/Visual Lisp [Выбрать] ---(vl-load-com)(defun c:sv_tabl (/ alltext _textfind _textfor kscale _block _name_fas minpoint_l maxpoint_l minpoint_h maxpoint_h diff_l diff_h _sum _sum_sq _visible bum bum_set bum_list quan fewlines cho num ) (setvar "Peditaccept" 1) (setq _sum 0.0) (setq _sum_sq 0.0) (setq alltext (ssget "_X" (list (cons 1 "*00 }") (cons 0 "Mtext")))) (setq _textfind (vlax-ename->vla-object (ssname alltext 0))) (setq _textfor (vla-get-textstring _textfind)) (if (wcmatch _textfor "*100 }") (setq kscale 0.01) (setq kscale 0.02) ) ;_ end of if (setq _acad (vlax-get-acad-object)) (setq active_doc (vla-get-activedocument _acad)) (setq m_space (vla-get-modelspace active_doc)) (setq _blockselect (ssget "_X" (list (cons 8 "_АХП_Фасад") (cons 0 "Insert")))) (setq counter 0) (princ (strcat "Найдено блоков:" (rtos (sslength _blockselect) 2 0) "шт.")) (terpri) (while (< counter (sslength _blockselect)) (setq _block (vlax-ename->vla-object (ssname _blockselect counter))) (setq _name_fas (vla-get-effectivename _block)) (vla-getboundingbox _block 'minpoint 'maxpoint) (setq minpoint_l (nth 0 (vlax-safearray->list minpoint))) (setq maxpoint_l (nth 0 (vlax-safearray->list maxpoint))) (setq minpoint_h (nth 1 (vlax-safearray->list minpoint))) (setq maxpoint_h (nth 1 (vlax-safearray->list maxpoint))) (setq diff_l (* kscale 10 (- maxpoint_l minpoint_l))) (setq diff_h (* kscale 10 (- maxpoint_h minpoint_h))) (setq l (rtos diff_l 2 1)) (princ (strcat "Длина " _name_fas ":" l "м")) (setq _visible (vlax-invoke _block 'getdynamicblockproperties)) (nth 0 _visible) (vla-put-value (nth 0 _visible) (vlax-make-variant "контур" (vlax-variant-type (vla-get-value (nth 0 _visible)))) ) ;_ end of vla-put-value (terpri) (command "_.bedit" _name_fas) ;;;Входим в блок (setq cho (ssget "_X" (list (cons 0 "Spline")))) ;;; Ищем все сплайны (if cho ;;; если нашли сплайны (progn (setq num (sslength cho)) ;;; определяем количество сплайнов (repeat num (command "_.splinedit" cho "_P" "25")) ;;; преобразуем все сплайны в полилинии (princ (strcat "Преобразовано в полилинии" (rtos num 2 0) "сплайнов")) ;;; информация о том, сколько было сплайнов преобразовано ) ;_ end of progn (princ "Не найдены сплайны") ) ;_ end of if (command "_bclose" "_s") ;;; закрываем блок (setq bum (vla-explode _block)) ;;; взрываем блок и получаем массив (setq bum_list (vlax-safearray->list (vlax-variant-value bum))) ;;; преобразуем массив в список (setq quan (vl-list-length bum_list)) ;;; подсчитываем количетсво объектов в списке (if (= quan 1) ;;; если количество равно 1 (progn (setq sq_a (* kscale (vlax-get-property (vlax-ename->vla-object (entlast)) 'area)))) ;;; то берем параметр площади объекта (progn (setq ss (ssadd)) ;;; иначе формируем набор (setq bum_set (foreach x bum_list (ssadd (vlax-vla-object->ename x) ss))) ;;; добавляем каждый элемент списка в набор (setq fewlines (command "_pedit" "_M" bum_set "" "_J" "_J" "_B" "100" "_X")) ;;; производим объединение всех объектов в одну замкнутую полилинию (практика показывает, что кроме замкнутой полилинии также формируется дополнительная полиния не относящаяся к замкнутой) (setq sq_a (* kscale (vlax-get-property (vlax-ename->vla-object (entlast)) 'area))) ;;; определяем площадь замкнутой полилинии (if (< sq_a 1) ;;; проверка выбра объекта, а именно замкнутой полилинии, а не дополнительной, итак если площадь < 1 (progn (setq sq_a (* kscale (vlax-get-property (vlax-ename->vla-object (entlast)) 'area))) ;;; то считаем площадь следующего объекта (в случае, если вначале была посчитана площадь незамкнутой линии, то будет считать замкнутой) ) ;_ end of progn ) ;_ end of if ) ;_ end of progn ) ;_ end of if (princ (strcat "Площадь:" (rtos sq_a 2 1) " м2")) (terpri) (vla-erase (vlax-ename->vla-object (entlast))) (setq _table (ssget "_X" (list (cons 1 (strcat "Характеристика здания (" _name_fas ") ")) (cons 0 "ACAD_TABLE")))) (setq _t (vlax-ename->vla-object (ssname _table 0))) (vla-settext _t 3 1 l) (vla-settext _t 1 1 (rtos diff_h 2 1)) (vla-settext _t 2 1 (rtos sq_a 2 1)) (setq _sum (+ _sum diff_l)) (setq _sum_sq (+ _sum_sq sq_a)) (vla-put-value (nth 0 _visible) (vlax-make-variant "фасад" (vlax-variant-type (vla-get-value (nth 0 _visible)))) ) ;_ end of vla-put-value (setq counter (+ counter 1)) ) ;_ end of while (princ (strcat "\nСуммарная длина фасадов:" (rtos _sum 2 1) "м")) (princ (strcat "\nСуммарная площадь фасадов:" (rtos _sum_sq 2 1) "м2")) (terpri) (setq a (rtos _sum 2 1)) (setq b (rtos _sum_sq 2 1)) (setq _tablex (ssget "_X" (list (cons 1 "Характеристика зданий") (cons 0 "ACAD_TABLE")))) (setq _t (vlax-ename->vla-object (ssname _tablex 0))) (vla-settext _t 2 1 a) (vla-settext _t 1 1 b) (setvar "Peditaccept" 0) ) ;_ end of defun
Peacemaker_kiss:
Сайт не даёт файл прикрепить?:(
Александр Ривилис:
--- Цитата: Peacemaker_kiss от 01-12-2014, 17:36:30 ---Сайт не даёт файл прикрепить?:(
--- Конец цитаты ---
Даёт. Если он конечно не огромный.
Peacemaker_kiss:
15 мб
Александр Ривилис:
--- Цитата: Peacemaker_kiss от 01-12-2014, 18:25:35 ---15 мб
--- Конец цитаты ---
Можно до 8 Mb. Может нет смысла постить таких размеров файл? Или как минимум попробовать его сжать.
Навигация
Перейти к полной версии