| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > "Вытягивание" площади из примитива "полилиния"

"Вытягивание" площади из примитива "полилиния"

Ответ
Поиск в этой теме
Непрочитано 28.12.2017, 17:02 #1
"Вытягивание" площади из примитива "полилиния"
Pavel1994
 
Регистрация: 24.03.2017
Сообщений: 39

Добрых времени суток, уважаемые! Нашел текстик для создания полилинии по внешнему контуру указанного чертежа (в моем случае торец павильона для басейнов, состоящий из дуг, ригелей и стоек). Идея в том что нужно получить площадь этой самой торцовой стены павильона. Первый нюанс - некорректно работает программа из-за размеров (решил проблему предварительной изоляцией размеров на чертеже с последующим восстановлением (понимаю что примитивно (но хотя бы в самом тексте лиспа)) и ВТОРАЯ (ГЛАВНАЯ) проблема - не могу понять в какой переменной сидит построенная полилиния для того что б вытянуть из нее площадь. Как именно вытянуть площадь тоже не знаю точно (но догадываюсь) так как только начинаю осваивать лисп (то-есть полный 0))) Помогите пожалуйста если знаете! (P.S. для меня пока что слишком сложный текстик, но буду обязательно расшифровывать (жду книгу уважаемого Полещука по лиспу)). Спасибо
Код:
[Выделить все]
 
;| ! *******************************************************************
;; !                  lib:IsPtInView
;; ! *******************************************************************
;; ! Проверяет находится ли точка в видовом экране
;; ! Auguments: 'pt'  — Точка для анализа в МСК!!!
;; ! Return   : T или nil если 'pt' в видовом экране или нет
;; ! *******************************************************************|;
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
(setq pt (trans pt 0 1))
(setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
   SSZ (getvar "SCREENSIZE") X_Pix (car SSZ) Y_Pix (cadr SSZ)
   X_Len (* (/ X_Pix Y_Pix) Y_Len)
   Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len))
   Uc (polar Lc 0.0 X_Len) Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len))
   Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len)))
(if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
   (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc))) T nil))
(defun DTR (a)(* pi (/ a 180.0)))(defun RTD (a)(/ (* a 180.0) pi))
; ! ***********************************************************
;; !                             lib:Zoom2Lst
;; ! **********************************************************
;; ! Function : Zoom границ списка точек
;; ! Arguments: 'vlist' — Список точек в МСК!!!!
;; ! Зуммирует экран, чтобы все точки были видны
;; ! Returns  : t — было зуммирование nil — нет
;; ! **********************************************************
(defun lib:Zoom2Lst( vlist / bl tr Lst OS)
(setq  Lst (lib:pt_extents vlist) bl (car Lst) tr (cadr Lst))
(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
(progn  (setq OS (getvar "OSMODE"))(setvar "OSMODE" 0)
  (command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1) "_.Zoom" "0.95x")
  (setvar "OSMODE" OS) T) NIL))
;| ! ***************************************************************************
;; !           lib:pt_extents
;; ! ***************************************************************************
;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек
;; ! Argument : 'vlist' — Список точек
;; ! Returns  : Список точек (ЛевНижн ПравВерхн)
;; ! ***************************************************************************|;
(defun  lib:pt_extents (vlist / tmp)
(setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x))
(mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist)) '(0 1 2))));_setq
  (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun
;http://www.caduser.ru/forum/index.php...&TID=30797
;External contour of objects
(defun C:ECO ( / *error* blk obj MinPt MaxPt hiden pt pl unnamed_block isRus
         tmp_blk adoc blks lays lay oname sel csp loc sc ec ret DS osm)
(defun *error* (msg)(mapcar '(lambda (x) (vla-put-Visible x :vlax-true)) hiden)
(vla-endundomark adoc)(if (and tmp_blk (not (vlax-erased-p tmp_blk))(vlax-write-enabled-p tmp_blk) )
(vla-Erase tmp_blk))(if osm (setvar "OSMODE" osm))(foreach x loc (vla-put-lock x :vlax-true)))
(vl-load-com)(setvar "CMDECHO" 0)(setq osm (getvar "OSMODE"))
(if (zerop (getvar "WORLDUCS"))(progn(vl-cmdf "_.UCS" "")(vl-cmdf "_.Plan" "")))
(setq isRus (= (getvar "SysCodePage") "ANSI_1251"))
(setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
        blks (vla-get-blocks adoc) lays (vla-get-layers adoc))
  (vla-startundomark adoc)(if isRus (princ "\nВыберите объекты для построения контура")(princ "\nSelect objects for making a contour"))
(if (setq sel (ssget))(progn
    (setq sel (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))))
    (setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel))))
    (setq unnamed_block (vla-add (vla-get-blocks adoc)(vlax-3d-point '(0. 0. 0.)) "*U"))
    (foreach x sel
      (setq oname (strcase (vla-get-objectname x)) lay  (vla-item lays (vla-get-layer x)))
        (if (= (vla-get-lock lay) :vlax-true)
          (progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc))))
      (cond ((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION")) nil)
       ((= oname "ACDBBLOCKREFERENCE")
        (vla-InsertBlock unnamed_block
          (vla-get-insertionpoint x)(vla-get-name x)
          (vla-get-xscalefactor x)(vla-get-yscalefactor x)
          (vla-get-zscalefactor x)(vla-get-rotation x))
        (setq blk (cons x blk)))
       (t (setq obj (cons x obj)))));_foreach
        (setq lay  (vla-item lays (getvar "CLAYER")))
        (if (= (vla-get-lock lay) :vlax-true)(progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc))))
     (if obj (progn (vla-copyobjects (vla-get-activedocument (vlax-get-acad-object))
              (vlax-make-variant (vlax-safearray-fill
                  (vlax-make-safearray vlax-vbobject (cons 0 (1- (length obj))))
                  obj)) unnamed_block)))
    (setq obj (append obj blk))
    (if obj (progn
          (setq tmp_blk (vla-insertblock csp (vlax-3d-point '(0. 0. 0.))(vla-get-name unnamed_block) 1.0 1.0 1.0 0.0))
          (vla-GetBoundingBox tmp_blk 'MinPt 'MaxPt)  ;_Границы блока
               (setq MinPt (vlax-safearray->list MinPt) MaxPt (vlax-safearray->list MaxPt)
           DS (max (distance MinPt (list (car MinPt)(cadr MaxPt)))
              (distance MinPt (list (car MaxPt)(cadr MinPt))))
                DS (* 0.2 DS) ;1/5
           DS (max DS 10) MinPt (mapcar '- MinPt (list DS DS))
                     MaxPt (mapcar '+ MaxPt (list DS DS)))
(lib:Zoom2Lst (list MinPt MaxPt))(setq sset (ssget "_C" MinPt MaxPt))
(if sset (progn (setvar "OSMODE" 0)
      (setq hiden (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
       hiden (vl-remove tmp_blk hiden))
      (mapcar '(lambda(x)(vla-put-Visible x :vlax-false)) hiden)
      (setq pt (mapcar '+ MinPt (list (* 0.5 DS)(* 0.5 DS))))
      (vl-cmdf "_.RECTANG" (trans MinPt 0 1)(trans MaxPt 0 1))
      (setq pl (vlax-ename->vla-object(entlast)))
      (setq sc (1-(vla-get-count csp)))
      (if (VL-CATCH-ALL-ERROR-P (VL-CATCH-ALL-APPLY '(lambda ()
         (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")
              (while (> (getvar "CMDACTIVE") 0)(command "")))))
      (if isRus (princ "\nНе удалось построить контур")(princ "\nIt was not possible to construct a contour")))
      (setq ec (vla-get-count csp))
        (while (< sc ec)(setq ret (append ret (list (vla-item csp sc))) sc(1+ sc)))
      (setq ret (vl-remove pl ret))
      (mapcar '(lambda (x)(vla-Erase x)(vlax-release-object x))(list pl tmp_blk))(setq pl nil tmp_blk nil)
      (setq ret (mapcar '(lambda ( x / mipt)(vla-GetBoundingBox x 'MiPt nil)  ;_Границы блока
                 (setq MiPt (vlax-safearray->list MiPt))(list MiPt x)) ret))
      (setq ret (vl-sort ret '(lambda (e1 e2)(< (distance MinPt (car e1))(distance MinPt (car e2))))))
      (setq pl (nth 1 ret) ret (vl-remove pl ret))(mapcar 'vla-erase (mapcar 'cadr ret))
      (mapcar '(lambda(x)(vla-put-Visible x :vlax-true)) hiden)
      (foreach x loc (vla-put-lock x :vlax-true))
      (if pl (progn (initget  "Yes No")
      (if (= (getkword (if isRus "\nУдалять объекты? [Yes/No] <No> : " "\nDelete objects? [Yes/No] <No> : ")) "Yes")
         (mapcar '(lambda (x) (if (vlax-write-enabled-p x)(vla-Erase x))) obj)))
   (if isRus (princ "\nНе удалось построить контур")(princ "\nIt was not possible to construct a contour")))))))
     (VL-CATCH-ALL-APPLY '(lambda ()(mapcar 'vlax-release-object
    (list unnamed_block tmp_blk csp blks lays))))));_if not
  (foreach x loc (vla-put-lock x :vlax-true))(setvar "OSMODE" osm)
  (vla-endundomark adoc)(vlax-release-object adoc)(princ))
(if (= (getvar "SysCodePage") "ANSI_1251")(princ "\nНаберите в командной строке ECO")(princ "\nType ECO in command line"))

Последний раз редактировалось Кулик Алексей aka kpblc, 28.12.2017 в 19:12.
Просмотров: 3102
 
Непрочитано 13.01.2018, 09:01 Площадь полилинии и др. объектов
#2
Андрей_Р71


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


(defun C:_S(/ xx)
(vl-load-com)
(setq xx(entsel"\nУкажи полилинию")
xx(vlax-ename->vla-object(car xx))
xx(vla-get-Area xx); в переменной хх будет площадь
)
)
Андрей_Р71 вне форума  
 
Непрочитано 13.01.2018, 10:00
#3
Setvar


 
Регистрация: 10.02.2007
Москва
Сообщений: 611


Еще вариант определения площади замкнутого контура:
Код:
[Выделить все]
(defun C:AREAK (/ pl s)
(setq pl (entsel "\n Выберите замкнутый контур: "))
(if pl 
    (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 " кв.м")
        ) ; progn
        (princ "\nЭто не есть замкнутая полилиния!")
    ) ; if
    (princ "\nНе выбран контур.")
) ; if
(princ)
)
Setvar вне форума  
 
Непрочитано 13.01.2018, 14:56
#4
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от Андрей_Р71 Посмотреть сообщение
в переменной хх будет площадь
Если у выбранного примитива вообще есть такое свойство.
Цитата:
Сообщение от Setvar Посмотреть сообщение
проверка замкнутости
Ну-ну... Я выберу сплайн, или блок, и что будем делать?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.01.2018, 11:59
#5
Setvar


 
Регистрация: 10.02.2007
Москва
Сообщений: 611


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Я выберу сплайн, или блок
Ну, ты можешь выбрать хоть забор на стройплощадке. Но ты ведь не автор темы и мой код не готовая программа. Я просто показал вариант нахождения площади контура из полилинии...
Setvar вне форума  
 
Непрочитано 14.01.2018, 19:35
#6
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


(setvar "EMOTIONSOVERREASON" nil)
koMon вне форума  
 
Непрочитано 15.01.2018, 08:08
#7
Кулик Алексей aka kpblc
Moderator

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


Че?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 15.01.2018, 17:59
#8
VVA

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


Цитата:
Сообщение от koMon Посмотреть сообщение
(setvar "EMOTIONSOVERREASON" nil)
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Че?
emotions over reason
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 24.02.2018, 17:33
#9
Pavel1994


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


Cпасибо всем кто ответил. К сожалению быстро никто не отреагировал и я все же нашел вариант, после того ка разобрался с книгой немного. Оказалось что все очень просто. Идея была в том что бы вставить площадь в текст. Выглядит моя маленькая доработка так:

(setq rg (entlast))
(setq dvla (vlax-ename->vla-object rg))
(vlax-dump-object dvla)
(setq dld1 (/ (vlax-get-property dvla "Area") 1000000))
(setq dld1 (rtos dld1 2 2))
(setq dld1 (strcat "S = " dld1 " m2"))
(command "_text" (getpoint "\nУкажите точку вставки") "150" "" dld1)
Pavel1994 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > "Вытягивание" площади из примитива "полилиния"

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 272 06.06.2021 23:12
Площади в Archicad alven ArchiCAD 25 25.02.2015 15:22
СП 54.13330.2011-откуда эта норма 500-550м2 общей площади квартир на этаже? Red_line Архитектура 2 07.05.2014 19:47
Отношение площади световых проемов к площади пола lee Архитектура 45 26.01.2011 06:54
Проблема извлечения площади примитива в CAD DEMOGOG Программирование 15 11.06.2009 15:44