[dew]

Всем привет! Идея примерно такая максимально автоматизировать процесс вычисления площадей и объемов помещений причем раздельно, либо так либо так.
В идеале хотелось бы получить примерно такое: имя план квартиры в масштабе 1:100 я нажимаю на кнопочку -площадь потом нажимаю внутрь замкнутого контура многоугольника, меня меню спрашивает : "название помещения" я вписываю например "жилая комната" дальше программа сама подписывает помещение и под дробью ставит площадь помещения.
То же самое с объемом только прописывает высоту помещения и вычисляет объем.

Описать немного сложно идею на всякий случай прилагаю готовый вариант того чего хотелось бы получить в результате. Причем очень важно то что маштаб помещения именно такой как на картинке поэтому площадь должна ему соответствовать.
Заранее спасибо надеюсь поможете мне в этом я думаю такое пригодится не только мне одному.

Работаю в автокаде 2012 но там определение площади немного трудновато реализованно......

прилагаю фаил "пример"

[Дима_]

В справку автокада - см. "поля", если будет мало - в поиск - подобных программ вагон и маленькая тележка.

[DEM]

Воспользуйся возможностями СПДС-ки....

[dew]

да но там нужно обходить все углы многоугольника и в итоге подписывать все самому, хотелось бі максимально ускорить этот процесс....

[Li6-D]

Когда линия плоская и состоит из прямых отрезков, площадь ею ограниченная вычисляется элементарно:

Код:

[Выделить все]

 (defun area (pN / p0 s)
;;Функция находит площадь, ограниченной линиями.
;;Аргумент pN - список точек линий.
  (setq p0 (last pN) s 0)
  (foreach p pN
    (setq s (+ s (* (- (car p) (car p0)) (+ (cadr p) (cadr p0)))) p0 p))
  (abs (* 0.5 s))
)

Список точек => площадь просто получается, если контур помещения обведен LW-полилинией:

Код:

[Выделить все]

 (area ;- функция area определена выше
;Выражение для расчета площади, ограниченной полилинией из отрезков
  (mapcar 'cdr
    (vl-remove-if '(lambda (x) (/= (car x) 10))
      (entget (ssname (ssget "_:S" '((0 . "LWPOLYLINE"))) 0))
) ) )

Ну а про масштаб и высоту помещения сам придумай.

[dew]

я в записи лиспа ничего не понимаю, язык не учил ( облазив гугл конкретно под мои задачи ничего не нашел но вот нечто подобное и более менее подходящее, если кто может переделать ее огромное спасибо за это:
1) 1-й пункт пусть делает автоматом "1-ин знак"
2) добавить ввод названия помещения
3) составляет запись с верху "название помещения" подчеркивает и под ним вычисленную площадь.
4) ну это уже наверное для совсем продвинутых пользователей - хотелось бы чтобы программа не использовала алгоритм подсчета только по полелинии а понимала еще и отрезки и вобще сама идея подсчета хорошо реализована в прикрепленном лиспе (см прикрепленый фаил Area.lsp ) , но она сводит все в таблицу, а не на чертеж и не имеет настройки масштаба , (((

Код:

[Выделить все]

 ;************AREA_K.LSP - Вычисление площади контура
;                          и простановка значения на плане
;
;         Разработал  Громов В.В. Апрель 1999, 2001.
;
(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"))
  ;  (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 "\n Выберите полилинию: ")
       (setq pl (entsel))
       (command "_AREA" "_O" pl)
       (setq s (getvar "area"))
       (setq s (/ s 100))
       (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 s)
           ))
           (command "_TEXT" ptt "" "" area)
       (princ "\n Площадь контура = ")(princ s) (princ " кв.м")
       (setvar "OSMODE" osm)
       (command "_-LAYER" "_S" slt "")
       (princ)

[Oliver_88]

Попробуй такой код.

Код:

[Выделить все]

 (defun c:boundarea (/ area	       util
		      point	       mt
		      mt2	       bound
		      bes-scale	       bes-get-text
		      s1	       scale
		      *acad_application*
		      *utility*	       bes-put-vla-object-property
		      bes-getstring    bes-getpoint
		      bes-getinteger   space)


  (vl-load-com)
  (setq *acad_application* (vlax-get-acad-object)
	*active_document* (vla-get-activedocument *acad_application*)
	*utility* (vla-get-Utility *active_document*)
	)
  
  (defun bes-getstring (str keywords / obj)
    (vla-InitializeUserInput *utility* 128 keywords)
    (if
      (and
	(not
	  (vl-catch-all-error-p
	    (setq obj
		   (vl-catch-all-apply
		     'vla-GetKeyWord
		     (list *utility* str)
		     )
		  )
	    )
	  )
	(> (strlen obj) 0)
	)
      obj
      )
    )
  
  (defun bes-getpoint (str / obj )
    (if
      (not
	(vl-catch-all-error-p
	  (setq obj
		 (vl-catch-all-apply
		   'vla-GetPoint
		   (list *utility* nil str)
		   )
		)
	  )
	)
      obj
      )
    )

(defun bes-getinteger (str  / obj)
  (vla-InitializeUserInput *utility*  4)
  (if
      (not
	(vl-catch-all-error-p
	  (setq obj
		 (vl-catch-all-apply
		   'vla-GetInteger
		   (list *utility* str)
		   )
		)
	  )
	)
    obj
    )
  )

  (defun bes-put-vla-object-property (obj property_name property)
  (if
    (not
      (vl-catch-all-error-p
	(vl-catch-all-apply
	  'vlax-put-property
	  (list obj property_name property)
	  )
	
	)
      )
    property
    nil
    )
  )
  
  (defun bes-scale ( / s1 p1 p2 scale)
    (if
      (and
	(princ (strcat "\nТекущий масштаб: " *bes_scale*))
	(setq scale (bes-getstring "\nВведите масштаб вида 1:x или х:1, где х - число: " ""))
	(setq s1 (vl-string-position  (ascii ":" ) scale))
	(numberp (setq p1 (atoi (substr scale 1 (1+ s1)))))
	(numberp (setq p2 (atoi (substr scale (+ 2 s1)))))
	(not (minusp p1))
	(not (minusp p2))
	(/= 0 p1)
	(/= 0 p2)
	(or
	  (= p1 1)
	  (= p2 1)
	  )
	)
      (progn
	(setq *bes_scale* (strcat (vl-princ-to-string p1) ":" (vl-princ-to-string p2)))
	(princ (strcat "\nТекущий масштаб: " *bes_scale*))
	(setq mt2 (bes-get-text))
	)
      (progn
	(princ (strcat "\nТекущий масштаб: " *bes_scale*))
	(setq mt2 (bes-get-text))
	t
	)
      )
    )

  (defun bes-get-text ( / scale mt2)
    (setq mt2 (bes-getstring "\nВведите название помещения или [Масштаб/Точность]:" "Масштаб Точность"))
    (if mt2
      (progn
	(cond
	  (
	   (equal mt2 "Масштаб")
	   (bes-scale)
	   )
	  (
	   (equal mt2 "Точность")
	   (princ (strcat "\nТекущая точность: " (itoa *bes-integer*)))
	   (setq *bes-integer* (bes-getinteger "\nВведите количество знаков после запятой: "))
	   (princ (strcat "\nТекущая точность: " (itoa *bes-integer*)))
	   (setq mt2 (bes-get-text))
	   )
	  )
	mt2
	)
      )
    )
  
  (if (not *bes_scale*)
    (setq *bes_scale* "1:100")
    )
  (if (not *bes-integer*)
    (setq *bes-integer* 1)
    )
  (if
    (and
      (setq point (bes-getpoint "\nУкажите точку внутри замкнутого контура:"))
      (setq bound (bpoly (vlax-safearray->list (vlax-variant-value point))))
      )
    (if (setq mt2 (bes-get-text))
      (progn
	(setq area (/ (vla-get-Area (vlax-ename->vla-object bound)) 1000000))
	(setq s1 (vl-string-position  (ascii ":" ) *bes_scale*))
	(setq scale
	       (list
		 (atoi (substr *bes_scale* 1 (1+ s1)))
		 (atoi (substr *bes_scale* (+ 2 s1)))
		 )
	      )
	(if (> (car scale)
	       (cadr scale)
	       )
	  (setq area (* area (expt (car scale) 2)))
	  (setq area (/ area (expt (cadr scale) 2)))
	  )
	(setq area (rtos area 2 *bes-integer*))
	(if
	  (= (vla-get-ActiveSpace *active_document*) 1)
	  (setq space (vla-get-ModelSpace *active_document*))
	  (setq space (vla-get-PaperSpace *active_document*))
	  )
	(setq mt
	       (vla-AddMtext space point 5
		 (strcat "\\A1;{\\H0.7x;\\S" mt2 "/"
			 (vl-princ-to-string area) " кв.м;}"
			 )
		 )
	      )
	(mapcar
	  (function
	    (lambda (a)
	      (bes-put-vla-object-property
		mt
		(car a)
		(cadr a)
		)
	      )
	    )
	  (list
	    '("AttachmentPoint" 5)
	    )
	  )
	)
      )
    )	
  (if
    bound
    (entdel bound)
    )
  (princ)
  )

[gomer]

бросайте так писать

[Profan]

Сообщение от dew сама идея подсчета хорошо реализована в прикрепленном лиспе (см прикрепленый фаил Area.lsp ) , но она сводит все в таблицу, а не на чертеж и не имеет настройки масштаба

А зачем ты привел здесь код моей программы, который не имеет никакого отношения к прикрепленному файлу?

[dew]

Профан я не разбираюсь в написании кода а взял твою программу так как она мне понравилась но не совсем подходит для моих целей, Кстати спасибо за нее
Ребята а гре в этом коде строка отвечающая за размер текста хочу увеличить в 1.5 раза

Код:

[Выделить все]

  
(defun c:boundarea (/ area        util
	              point        mt
	              mt2          bound
	              bes-scale        bes-get-text
	              s1           scale
	              *acad_application*
	              *utility*        bes-put-vla-object-property
	              bes-getstring    bes-getpoint
	              bes-getinteger   space)
	 
	 
	  (vl-load-com)
	  (setq *acad_application* (vlax-get-acad-object)
	    *active_document* (vla-get-activedocument *acad_application*)
	    *utility* (vla-get-Utility *active_document*)
	    )
	   
	  (defun bes-getstring (str keywords / obj)
	    (vla-InitializeUserInput *utility* 128 keywords)
	    (if
	      (and
	    (not
	      (vl-catch-all-error-p
	        (setq obj
	           (vl-catch-all-apply
	             'vla-GetKeyWord
	             (list *utility* str)
	             )
	          )
	        )
	      )
	    (> (strlen obj) 0)
	    )
	      obj
	      )
	    )
	   
	  (defun bes-getpoint (str / obj )
	    (if
	      (not
	    (vl-catch-all-error-p
	      (setq obj
	         (vl-catch-all-apply
	           'vla-GetPoint
	           (list *utility* nil str)
	           )
	        )
	      )
	    )
	      obj
	      )
	    )
	 
	(defun bes-getinteger (str  / obj)
	  (vla-InitializeUserInput *utility*  4)
	  (if
	      (not
	    (vl-catch-all-error-p
	      (setq obj
	         (vl-catch-all-apply
	           'vla-GetInteger
	           (list *utility* str)
	           )
	        )
	      )
	    )
	    obj
	    )
	  )
	 
	  (defun bes-put-vla-object-property (obj property_name property)
	  (if
	    (not
	      (vl-catch-all-error-p
	    (vl-catch-all-apply
	      'vlax-put-property
	      (list obj property_name property)
	      )
	     
	    )
	      )
	    property
	    nil
	    )
	  )
	   
	  (defun bes-scale ( / s1 p1 p2 scale)
	    (if
	      (and
	    (princ (strcat "\nТекущий масштаб: " *bes_scale*))
	    (setq scale (bes-getstring "\nВведите масштаб вида 1:x или х:1, где х - число: " ""))
	    (setq s1 (vl-string-position  (ascii ":" ) scale))
	    (numberp (setq p1 (atoi (substr scale 1 (1+ s1)))))
	    (numberp (setq p2 (atoi (substr scale (+ 2 s1)))))
	    (not (minusp p1))
	    (not (minusp p2))
	    (/= 0 p1)
	    (/= 0 p2)
	    (or
	      (= p1 1)
	      (= p2 1)
	      )
	    )
	      (progn
	    (setq *bes_scale* (strcat (vl-princ-to-string p1) ":" (vl-princ-to-string p2)))
	    (princ (strcat "\nТекущий масштаб: " *bes_scale*))
	    (setq mt2 (bes-get-text))
	    )
	      (progn
	    (princ (strcat "\nТекущий масштаб: " *bes_scale*))
	    (setq mt2 (bes-get-text))
	    t
	    )
	      )
	    )
	 
	  (defun bes-get-text ( / scale mt2)
	    (setq mt2 (bes-getstring "\nВведите название помещения или [Масштаб/Точность]:" "Масштаб Точность"))
	    (if mt2
	      (progn
	    (cond
	      (
	       (equal mt2 "Масштаб")
	       (bes-scale)
	       )
	      (
	       (equal mt2 "Точность")
	       (princ (strcat "\nТекущая точность: " (itoa *bes-integer*)))
	       (setq *bes-integer* (bes-getinteger "\nВведите количество знаков после запятой: "))
	       (princ (strcat "\nТекущая точность: " (itoa *bes-integer*)))
	       (setq mt2 (bes-get-text))
	       )
	      )
	    mt2
	    )
	      )
	    )
	   
	  (if (not *bes_scale*)
	    (setq *bes_scale* "1:100")
	    )
	  (if (not *bes-integer*)
	    (setq *bes-integer* 1)
	    )
	  (if
	    (and
	      (setq point (bes-getpoint "\nУкажите точку внутри замкнутого контура:"))
	      (setq bound (bpoly (vlax-safearray->list (vlax-variant-value point))))
	      )
	    (if (setq mt2 (bes-get-text))
	      (progn
	    (setq area (/ (vla-get-Area (vlax-ename->vla-object bound)) 100))
	    (setq s1 (vl-string-position  (ascii "100:1" ) *bes_scale*))
	    (setq scale
	           (list
	         (atoi (substr *bes_scale* 1 (1+ s1)))
	         (atoi (substr *bes_scale* (+ 2 s1)))
	         )
	          )
	    (if (> (car scale)
	           (cadr scale)
	           )
	      (setq area (* area (expt (car scale) 2)))
	      (setq area (/ area (expt (cadr scale) 2)))
	      )
	    (setq area (rtos area 2 *bes-integer*))
	    (if
	      (= (vla-get-ActiveSpace *active_document*) 1)
	      (setq space (vla-get-ModelSpace *active_document*))
	      (setq space (vla-get-PaperSpace *active_document*))
	      )
	    (setq mt
	           (vla-AddMtext space point 5
	         (strcat "\\A1;{\\H0.7x;\\S" mt2 "/"
	             (vl-princ-to-string area) " м2;}"
	             )
	         )
	          )
	    (mapcar
	      (function
	        (lambda (a)
	          (bes-put-vla-object-property
	        mt
	        (car a)
	        (cadr a)
	        )
	          )
	        )
	      (list
	        '("AttachmentPoint" 5)
	        )
	      )
	    )
	      )
	    )  
	  (if
	    bound
	    (entdel bound)
	    )
	  (princ)
	  )

[Дима_]

строка 174 H0.7x в кавычках - это коэффицент.

[dew]

спасибо всем за реальную помощь, и отдельное Oliver_88 твой код работает очень хорошо!!
остался еще 1-ин пункт : создать вторую программу на основе программы Oliver_88 только которая еще выдает запрос на высоту и выдает результат в таком виде "вводимое с клавиатуры название комнаты" - под чертой - (V="вычисленный объем"м3) , еще ниже строка- (Н="вводимая с клавиатуры высота"м.)