Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → Готовые программы → LISP. Вычисление площади контура и простановка значения на плане
> Михаил74
У меня не проводится проверка на задание фиксированной высоты текста в текущем стиле. Предполагается, что она равна нулю. Если же она не равна нулю, то строка в коде
(command "_TEXT" ptt "" "" area)
должна быть такой:
(command "_TEXT" ptt "" area)
А разве у вас все стили с фиксированной высотой шрифта?
Да к сожалению все у всех разное (СТП ни каких)
только, я вот уже думаю что не надо никаких стилей определенных, только если свой создавать для команды? но это не для меня. Ятд пусть привыкают к данному варианту как есть.
Куда интегрировать програму, точнее в какую папку самой программы,чтоб все заработало?
По-моему, здесь все написано:
https://www.caduser.ru/oldlink/faq/?part=44
Никак не хочет работать в 2007м.
Пишет неизвестная команда.
Всё загружаю как всегда.
Владимир, отличныи Lisp!
Мне он очень поможет, только он пишет лишь цифровое значение площади,а Area= и кв.м не пишет.Может я делаю что-то не так?(Я работаю на 2008-м)
Очень жду ответа!
> alex
В 2008 не проверял еще. В ближайшее время посмотрю.
> alex
Значение площади вставляется в чертеж без "кв.м". Эти буквы пишутся только в командной строке.
Владимир,это-то я понял, а как-бы сделать так, чтоб и "кв.м" проставлялись? Ведь Lisp призван упрощать работу, а то иди проставь на плане 200 раз "кв.м".! Даже, если сделать из "кв.м". блок!
С уважением!
> alex
По вашей просьбе:
(defun C:AREAK (/ slt pre pl s ptt)
(setvar "cmdecho" 0)
(setq osm (getvar "OSMODE"))
(setq slt (getvar "CLAYER"))
(if (null prec) (setq prec "1"))
(princ (strcat "\n Количество знаков после точки (0, 1, 2) <" prec ">: "))
(setq pre (getint))
(if (= pre nil) (setq pre (atoi prec)))
(if (> pre 2)
(progn
(setq pre 2)
(alert " Перебор! Ограничимся 2-мя знаками.")
))
(setq prec (itoa pre))
(princ "\n Выберите полилинию: ")
(setq pl (entsel))
(command "_AREA" "_O" pl)
(setq s (getvar "area"))
(setq s (/ s 1000000))
(princ "\n Площадь контура = ")(princ s) (princ " кв.м")
(cond
((<= pre 0) (setq s (rtos s 2 0)))
((= pre 1) (setq s (rtos s 2 1)))
((>= pre 2) (setq s (rtos s 2 2)))
)
(initget "д l н")
(setq dn (getkword "\n Подчеркивать число (да,нет)? <н>: "))
(setvar "OSMODE" 0)
(setq ptt (getpoint "\n Укажите место размещения текста: "))
(if (or (= dn "д") (= dn "l"))
(progn
(command "_-LAYER" "_M" "Помещения" "")
(setq area (strcat "%%U" s " кв.м" "%%U"))
))
(if (or (= dn "н") (= dn nil))
(progn
(command "_-LAYER" "_M" "Экспликация" "")
(setq area (strcat s " кв.м"))
))
(command "_TEXT" ptt "" "" area)
(princ "\n Площадь контура = ")(princ s) (princ " кв.м")
(setvar "OSMODE" osm)
(command "_-LAYER" "_S" slt "")
(princ)
)Огромное спасибо!
Модернизированный код:
(defun C:AREAK (/ slt pl s dn area ptt)
(setvar "cmdecho" 0)
(setq osm (getvar "OSMODE"))
(setq slt (getvar "CLAYER"))
(vl-cmdf "_AREA" 0 "")
(if (null prec) (setq prec "1"))
(initget 4 "0 1 2")
(princ (strcat "\n Количество знаков после точки [0/1/2] <" prec ">: "))
(setq pre (getint))
(if (= pre nil) (setq pre (atoi prec)))
(if (> pre 2)
(progn
(setq pre 2)
(alert " Дико извиняюсь! Ограничимся 2-мя знаками.")
))
(setq prec (itoa pre))
(while (null pl)
(setq pl (entsel "\n Выберите замкнутый контур: "))
(if pl
(progn
(if (= (cdr (assoc 70 (entget (car pl)))) 1)
(Progn
(command "_AREA" "_O" pl)
(setq s (getvar "area"))
(setq s (/ s 1000000))
(princ "\n Площадь контура = ")(princ s) (princ " кв.м")
(cond
((<= pre 0) (setq s (rtos s 2 0)))
((= pre 1) (setq s (rtos s 2 1)))
((>= pre 2) (setq s (rtos s 2 2)))
) ;cond
(if (not da) (setq da "Нет"))
(initget "Да Нет")
(princ (strcat "\n Подчеркивать число [Да/Нет] <" da ">: "))
(setq dn (getkword))
(if (= dn nil) (setq dn da))
(setq da dn)
(setvar "OSMODE" 0)
(if (= dn "Да")
(progn
(command "_-LAYER" "_M" "Помещения" "")
(setq area (strcat "%%U" s "%%U"))
)) ; progn,if
(if (= dn "Нет")
(progn
(command "_-LAYER" "_M" "Экспликация" "")
(setq area s)
)) ; progn,if
(princ "\n Укажите место размещения текста: ")
(setq kod40 (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
(if (= kod40 0)
(command "_TEXT" "0,0" "" "" area "_copybase" "0,0" (entlast) "" "_erase" (entlast) "" "_pasteclip" pause)
(command "_TEXT" "0,0" "" area "_copybase" "0,0" (entlast) "" "_erase" (entlast) "" "_pasteclip" pause)
) ;if
(princ "\n Площадь контура = ")(princ s) (princ " кв.м")
) ;progn
(progn
(setq pl nil)
(princ "\n Это не есть замкнутая полилиния! Попробуйте еще раз.")
) ;progn
) ;if
) ;progn
(princ "\n Замкнутый контур не выбран! Попробуйте еще раз.")
) ;if
) ;while
(setvar "OSMODE" osm)
(command "_-LAYER" "_S" slt "")
(princ)
)Вычисление площади контура и простановка значения в экспликацию.
(defun C:AREA_EKS (/ echo osm slt pl s pp reg minp maxp
vlaobj pmin pmax pxy kod40)
(vl-load-com)
(setq echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq osm (getvar "OSMODE"))
(setq slt (getvar "CLAYER"))
(vl-cmdf "_AREA" 0 "")
(if (null prec)
(progn
(alert "\n Не задана точность для определения площади!")
(princ "\n Задайте точность для определения площади.")
(load "area_prec")
))
(while (null pl)
(setq pl (entsel "\n Выберите замкнутый контур: "))
(if pl
(progn
(if (= (cdr (assoc 70 (entget (car pl)))) 1)
(Progn
(command "_AREA" "_O" pl)
(setq s (getvar "area"))
(setq s (/ s 1000000))
(princ "\n Площадь контура = ")(princ s) (princ " кв.м")
(cond
((<= pre 0) (setq s (rtos s 2 0)))
((= pre 1) (setq s (rtos s 2 1)))
((>= pre 2) (setq s (rtos s 2 2)))
) ; cond
(setvar "OSMODE" 0)
(princ "\n Текущая высота текста: ")
(princ (getvar "TEXTSIZE"))
(initget 6)
(setq pp (getpoint "\n Укажите точку внутри ячейки: "))
(vl-cmdf "_BOUNDARY" "_A" "_O" "_R" "" pp "")
(setq reg (entlast))
(if reg
(progn
(setq vlaobj(vlax-ename->vla-object reg))
(vla-GetBoundingBox vlaobj 'minp 'maxp)
(setq
pmin(vlax-safearray->list minp)
pmax(vlax-safearray->list maxp)
pxy (list
(+(car pmin)(/(-(car pmax)(car pmin))2))
(+(cadr pmin)(/(-(cadr pmax)(cadr pmin))2))
)
); setq
(vl-cmdf "_ERASE" reg "")
(princ "\n Одна область удалена.")
(command "_-LAYER" "_M" "Экспликация" "")
(setq kod40 (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
(if (= kod40 0)
(vl-cmdf "_TEXT" "_J" "_M" pxy "" "" s)
(vl-cmdf "_TEXT" "_J" "_M" pxy "" s)
) ; if
); progn
); if
(princ "\n Площадь контура = ")(princ s) (princ " кв.м")
) ;progn
(progn
(setq pl nil)
(princ "\n Это не есть замкнутая полилиния! Попробуйте еще раз.")
) ;progn
) ;if
) ; progn
(princ "\n Контур не выбран! Попробуйте еще раз.")
) ;if
) ;while
(setvar "cmdecho" echo)
(setvar "OSMODE" osm)
(command "_-LAYER" "_S" slt "")
(princ)
)Экспликация должна быть отрисована отрезками или полилиниями. Используется текущий стиль текста.
Для работы этой программы требуется дополнительная программа:
;*************** area_spec.lsp ******************************************
; Задание точности при определении площади.
(apply '(lambda ()
(if (null prec) (setq prec "1"))
(initget 4 "0 1 2")
(princ (strcat "\n Количество знаков после точки [0/1/2] <" prec ">: "))
(setq pre (getint))
(if (= pre nil) (setq pre (atoi prec)))
(if (> pre 2)
(progn
(setq pre 2)
(alert " Дико извиняюсь! Ограничимся 2-мя знаками.")
))
(setq prec (itoa pre))
(princ)
)
'()
)Класс! Даже и не мечтал об экспликации!
Ну просто угодили!
Спа-си-бо!
Подскажите пожалуйста, куда и каким образом эту программу влючить в Autocad, чтоб она работала
> Николай
Читай http://dwg.ru/art/8
А нет ли идейки, как эту площадь динамически менять при изменении исходного примитива?
_.field
> ajlena
Если пользоваться ADT то
- можно создавать динамически изменяемые площади, периметры, наименования помещений и много чего на основе внутренних возможностей программы
- создавать автоматически обновляемые спецификации
- обсчитывать соввокупности файлов (например подсчет площадей многоэтажного здания)
Выше был вопрос о подсчете длин ребер и площадей поверхности объектов 3DSOLID (тела)
это можно сделать так же стандартными средствами ADT предварительно разбив 3Dsolid на регионы, а затем на линии. Создав спец таблицу в ADT можно подсчитать сумму длин линий (т е ребер тела) и площадь поверхности регионов (т е поверхность тела)
> Yuriy
Значит, вы предлагаете тем, у кого есть только AutoCAD, раскошелиться еще и на ADT?
> Владимир Громов
*** Значит, вы предлагаете тем, у кого есть только AutoCAD, раскошелиться еще и на ADT? ***
Нет я предлагаю тем кто собирается приобретать Автокад отдать предпочтение ADT даже если набор архитектурно-строительных средств в полной мере не требуется.
Ну а тем у кого он есть хорошенько подумать об этом при переходе на последующие версии.
А разница в цене между ACAD и ADT очень даже невелика причем все возможности автокада в ADT присутствуют полностью.
Уже высказывалось мнение, что, дескать, пользовательские программы на фиг не нужны....
> Владимир Громов
*** Уже высказывалось мнение, что, дескать, пользовательские программы на фиг не нужны.... ***
Нужны! Нужны!! Очень нужны!!!
При решении практических вопросов, перебрав все возможные способы выбираешь лучший.
И лучшим зачастую оказываются именно пользовательские программы.
А если нет, то все равно возникнет ситуация при которой стандартный инструментарий не справляется и тогда пишешь новую или модифицируешь написанную ранее пользовательскую программу.
С уважением отношусь ко всем разработчикам пользовательских программ.
> Владимир Громов
Владимир! вопрос лично к вам.
Почему вы не в ADT изначально?
B если нет желания на него переходить сейчас или в дальнейшем то почему?
Денег нет на лицензионный AA.
Форумы CADUser → Программирование → Готовые программы → LISP. Вычисление площади контура и простановка значения на плане
Форум работает на PunBB, при поддержке Informer Technologies, Inc
