Lisp for Adding and Subtracting Polyline Areas

[Dynaformer]

Hi everyone,

 

I am looking for a lisp that will allow me to add and subract areas of polylines and place it as text on the drawing. I am aware of couple of lisps that allow adding and labeling, but couldnt find one that also does subtractions. Thanks.

[Tharwat]

Can you please explain more your aim of the lisp or bring a photo as ( before and after ) ?

 

Thanks

[Dynaformer]

Sure. I basicly want to calculate areas of certain spaces in a floorplan. There are areas that I want to add and there are areas which I want to subtract or remove (such as elevator shafts or a zone in a room). Autocad's area command already does that as you select objects defined as polylines. However, I would like to be able place the result as text in square meters.

[Tharwat]

Here is a quick draft .... check and tell me back

 

(defun c:TesT (/ selectionset point areas)
 (vl-load-com)
;;; Tharwat 18 . March . 2012 ;;;
 (if (and (setq selectionset (ssget '((0 . "LWPOLYLINE"))))
          (setq point (getpoint "\n Specify point for Text :")
                areas 0.
          )
     )
   (progn
     ((lambda (intger / selectionsetname entlist)
        (while
          (setq selectionsetname
                 (ssname selectionset
                         (setq intger (1+ intger))
                 )
          )
           (if (vlax-curve-isclosed selectionsetname)
             (setq
               areas (+ areas
                        (vla-get-area
                          (vlax-ename->vla-object selectionsetname)
                        )
                     )
             )
           )
        )
      )
       -1
     )
     (if (not (zerop areas))
       (entmakex
         (list '(0 . "TEXT")
               (cons 10 point)
               (cons 40
                     (if (zerop (cdr (assoc 40
                                            (setq entlist
                                                   (entget
                                                     (tblobjname "STYLE" (getvar 'textstyle))
                                                   )
                                            )
                                     )
                                )
                         )
                       (cdr (assoc 42 entlist))
                       (cdr (assoc 40 entlist))
                     )
               )
               (cons 7 (getvar 'textstyle))
               (cons 1 (strcat (rtos (/ areas 1000.) 2) "m²"))
               '(50 . 0.0)
         )
       )
     )
   )
   (princ)
 )
 (princ)
)

[Dynaformer]

Thanks for your help. Unfortunately, the remove/subtract option does not work. It selects the remove object (but doesn't show dash lines like it does when it selects an adds an object, it just says it selected an object) and when I hit add, it just gives me the value for the added object.

[Tharwat]

Did you try to press shift and re-select polylines to subtract them from the selection set ?

[Dynaformer]

Hi, I can't get it to work. Could you tell me what to do step by step? I am probably missing one of the steps. Here is how I try to do. I write the command line. I select the polyline to add. Then I hit shift and R to remove. I select a polyline to remove. It then asks me to pick a point for text. I do and the result is the value of the added object.

[Tharwat]

Hi .

 

Just select the closed polylines that you want to get their areas ' values and then ( if you want to subtract any polyline from the first selection , just keep pressing SHIFT and select the unneeded polylines

to subtract them from the selection set and then you should pick a point to have the value in Text entity .

 

slight modification to include light and heavy polylines

 

(defun c:TesT (/ selectionset point areas)
 (vl-load-com)
;;; Tharwat 19 . March . 2012 ;;;
 (if (and (setq selectionset (ssget '((0 . [b][color="blue"]"*POLYLINE")[/color][/b])))
          (setq point (getpoint "\n Specify point for Text :")
                areas 0.
          )
     )
   (progn
     ((lambda (intger / selectionsetname entlist)
        (while
          (setq selectionsetname
                 (ssname selectionset
                         (setq intger (1+ intger))
                 )
          )
           (if (vlax-curve-isclosed selectionsetname)
             (setq
               areas (+ areas
                        (vla-get-area
                          (vlax-ename->vla-object selectionsetname)
                        )
                     )
             )
           )
        )
      )
       -1
     )
     (if (not (zerop areas))
       (entmakex
         (list '(0 . "TEXT")
               (cons 10 point)
               (cons 40
                     (if (zerop (cdr (assoc 40
                                            (setq entlist
                                                   (entget
                                                     (tblobjname "STYLE" (getvar 'textstyle))
                                                   )
                                            )
                                     )
                                )
                         )
                       (cdr (assoc 42 entlist))
                       (cdr (assoc 40 entlist))
                     )
               )
               (cons 7 (getvar 'textstyle))
               (cons 1 (strcat (rtos (/ areas 1000.) 2) "m²"))
               '(50 . 0.0)
         )
       )
     )
   )
   (princ)
 )
 (princ)
)

Edited March 19, 2012 by Tharwat
changed the word MText to Text

[stevesfr]

@T

shift doesn't work here (using AC2008) and area is pasted in as plain text not Mtext ? sorry for bad review .

Steve

[Tharwat]

shift doesn't work here ( using AC2008 )

 

Odd indeed , your system variable pickadd might be equal to 0 ( just a guess ) .

 

and area is pasted in as plain text not Mtext ?

 

Yes it is Text and not Mtext .

 

Thanks

[VVA]

I have lisp for adding and subtracting polyline areas use field. Field values ​​are inserted into a table cell. There are modes of subtraction and summation

Designed for rapid data collection areas in the specification table

(defun C:AREATT ( / en obj tblobj row col lst pt rows cols what fld str)
;;; Command: AREATT (AREA To Table)
;;; Posted http://dwg.ru/f/showthread.php?t=14528
;;; Vladimir Azarko (VVA)
;;; This command allows you to insert from the specified table cell
;;; The text from the field (FIELD), which contains the value of the selected area of the circuit.
;;; Depending on the selection, navigation is on the table by rows or columns.
;;; If the rows or columns to an end, they are automatically added.
;;; Formatting cells is taken as the first mentioned.
;;; Accuracy, and rounding the scale factor settings are configured through the option Settings
;;; Since this field is related to a specific object, changing the
;;; object field is converted (to update the field)
;;; Code can be stored in a file areatt.lsp
;;; Possible macro to a button or menu item:
;;; ^C^C(if(not C:AREATT)(load "AREATT"));AREATT;
 
;;;;  Команда: AREATT (AREA To Table)
;;;;  posted http://dwg.ru/f/showthread.php?t=14528
;;;;  Vladimir Azarko (VVA)  
;;;;  Эта команда позволяет вставлять начиная с указанной ячейки таблицы
;;;;  текст с полем (FIELD), которое содержит значение площади выбранного контура.
;;;;  В зависимости от выбора, навигация по таблице идет по строкам или столбцам.
;;;;  Если строки или столбцы заканчиваются, то они автоматически добавляются.
;;;;  Форматирование ячейки берется как у первой указанной.
;;;;  Точность округления и масштабный коэффициент настраиваются через опцию Установки
;;;;  Так как это поле связано с конкретным объектом, то при изменении
;;;;  объекта поле пересчитывается (необходимо обновление поля)
;;;;  Код можно сохранить в файле areatt.lsp
;;;;  Возможный макрос для кнопки или пункта меню:
;;;;  ^C^C(if (not C:AREATT)(load "AREATT"));AREATT;
 
 (vl-load-com)
 (or *SCALE* (setq *SCALE* 1))
 (or *PREC* (setq *PREC* 2))
 (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
 (or *SUFF* (setq *SUFF* ""))(or *PREF* (setq *PREF* ""))
 (setq *SUFF* (vl-princ-to-string *SUFF*))
 (setq *PREF* (vl-princ-to-string *PREF*))
 (princ "\ nCurrent scale =") (princ *SCALE*)
  (princ "Current rounding precision =") (princ *PREC*)
  (princ "Text height =") (princ *TEXTSIZE*)
  (princ "Prefix =")(princ *PREF*)(princ "Suffix =")(princ *SUFF*)
 (and
   (setq  tblobj nil tblobj (ssget "_X" (list '(0 . "ACAD_TABLE")(cons 410 (getvar "CTAB")))))
   (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblobj)))))
   )
 (setq  tblobj nil)
 (cond
  ((and lst
        (or (initget "Row Column Setting") t)
        (or (while (=(setq what (getkword "\nMove [by Row/by Column/Settings]<by Column>: "))
                     "Setting")
                    (princ "\nThe new scale factor <")(princ *SCALE*)(princ "> : ")
     (initget 6)
     (if (setq en (getdist))(setq *SCALE* en))
     (princ "\nPrecision rounding <")(princ *PREC*)(princ "> : ")
     (initget 4)
     (if (setq en (getint))(setq *PREC* en))
     (princ "\nThe height of the text <")(princ *TEXTSIZE*)(princ "> : ")
     (initget 6)
     (if (setq en (getdist))(setq *TEXTSIZE* en))
     (princ "\nPrefix (Space - to clear) <")(princ *PREF*)(princ "> : ")
     (if (= (setq en (getstring t)) " ")(setq en ""))
     (if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
     (setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *PREF* en)
     (princ "\nSuffix (Space - to clear) <")(princ *SUFF*)(princ "> : ")
     (if (= (setq en (getstring t)) " ")(setq en ""))
     (if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
     (setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *SUFF* en)
              (initget "Row Column Setting")
              )
            t
            )
        (or what (setq what "Column"))
        (or
       (while (null  tblobj)
         (initget 1)
         (setq pt (getpoint "\nPick a table cell:"))
         (mapcar '(lambda (x)
          (or tblobj
              (and
                (= :vlax-true (vla-HitTest x
                              (vlax-3d-point (trans pt 1 0))
                              (vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
                              'row 'col))
                (setq tblobj x)
                )
              )
          )
       lst)
         (if (null  tblobj)(princ " ** missed **"))
         )
       t)
        (or
          (vlax-write-enabled-p tblobj)
          (and
            (princ "\nTABLE on a locked layer!")
            nil
            )
          )
        (setq pt (vla-GetCellAlignment tblobj row col))
        )
   (setq rows (vla-get-rows tblobj))
   (setq cols (vla-get-columns tblobj))
   (initget "+ -")
   (while (setq en (entsel "\nSelect the object to insert the value of its area in a table cell: (+ summation; - subtract; ENTER - complete):" ))
     (if (listp en)(setq en (car en)))
     (setq fld nil)
     (cond
      ((member en '("+" "-"))
(setq str en fld "%<\\AcExpr (" lst nil)
(while (setq en (car(entsel
		  (strcat "\n" (if (= str "+") "SUMMATION > " "SUBTRACT > ")
				 "Select the object to insert the value of its area in a table cell (ENTER - complete):" ))
	     ))
  (if (vlax-property-available-p (setq en (vlax-ename->vla-object en)) 'Area)
    (progn
      (setq lst (cons en lst))
      (vla-Highlight en :vlax-true)
   (setq fld (strcat fld "%<\\AcObjProp Object(%<\\_ObjId "
            (vl-princ-to-string(Get-ObjectID-x86-x64 en))
               ">%).Area \\f \"%lu2%ps["*PREF* "," *SUFF*
               "]%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALE*)"]\">%"
	str	     
               ) ;_ strcat
	 )
   )
    (princ "\nFor this entity can not get a property Area!")
    )
  )
(mapcar '(lambda(x)(vla-Highlight x :vlax-false)) lst)
(setq fld (strcat (vl-string-right-trim str fld) ")>%"))
)
      ((vlax-property-available-p (setq en (vlax-ename->vla-object en)) 'Area)
         (setq fld (strcat "%<\\AcObjProp Object(%<\\_ObjId "
            (vl-princ-to-string(Get-ObjectID-x86-x64 en))
               ">%).Area \\f \"%lu2%ps["*PREF* "," *SUFF*
               "]%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALE*)"]\">%"
               ) ;_ strcat
         )
      )
      (t(princ "\nFor this entity can not get a property Area!"))
     )
     (if (= (type fld) 'STR)
(progn
  (cond
         ((= col cols)
           (vla-insertColumns tblobj col (vla-GetColumnWidth tblobj (1- col)) 1)
           (vla-SetCellAlignment tblobj row col pt)
           (setq rows (vla-get-rows tblobj))
           (setq cols (vla-get-columns tblobj))
           
         )
         ((= row rows)
           (vla-insertRows tblobj row (vla-GetRowHeight tblobj (1- row)) 1)
          (vla-SetCellAlignment tblobj row col pt)
           (setq rows (vla-get-rows tblobj))
           (setq cols (vla-get-columns tblobj))
        )
         (t nil))
       (vla-SetText tblobj row col fld)
       (if (= what "Col")(setq col (1+ col))(setq row (1+ row)))
  )
)
    (initget "+ -")
   )
  )
  (t
    (alert "\nTables not been found...")
  )
 )
 (princ)
)
;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
;; http://forum.dwg.ru/showthread.php?t=51822
;;--------------------------------------------------------
(defun Get-ObjectID-x86-x64 (obj / util)
 (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
 (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
 (if (= (type obj) 'VLA-OBJECT)
    (if (> (vl-string-search "x64" (getvar "platform")) 0)
      (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
      (rtos (vla-get-objectid obj) 2 0)
    )
 )
)

[pBe]

Sure. I basicly want to calculate areas of certain spaces in a floorplan. There are areas that I want to add and there are areas which I want to subtract or remove (such as elevator shafts or a zone in a room). Autocad's area command already does that as you select objects defined as polylines. However, I would like to be able place the result as text in square meters.

 

Will that be a one (1) Polyline for Total area then select objects to subtract?

If it is:

 

(defun c:SubArea ( / txtht ar e pl pls i str)
(vl-load-com)      
(setq txtht (cond ((getdist (strcat
               "\nEnter Text Height [Enter to accept: <"
               (rtos (setq txtht (getvar 'textsize)) 2 2)
               ">: ")))(txtht)
         ))
(setvar 'textsize txtht )
(princ "\nSelect Polyline for Area:")
(cond ((and (setq ar 0
                 pl (ssget "_:S:E" '((0 . "*POLYLINE"))))
           (progn (redraw (ssname pl 0) 3)
                  (princ "\t<<<< Select Objects to Subtract >>>>")
                  (setq plS (ssget)))
           (repeat (setq i (sslength pls))
                 (if (vlax-property-available-p
                           (setq e    (vlax-ename->vla-object
                                            (ssname
                                                  pls
                                                  (setq i    (1- i)))))
                           'Area)
                       (setq ar (+ (vla-get-area e) ar))
                       T
                       )
                 )
           (setq pt (getpoint "\nPick point for Text:"))
           (entmakex
                 (list (cons 0 "MTEXT")
                       (cons 100 "AcDbEntity")
                       (cons 100 "AcDbMText")
                       (cons 10 pt)
                       (cons 1
  (setq str  (rtos (- (vla-get-area
   (vlax-ename->vla-object (ssname pl 0))) ar)
                                              2 2)
                                   )))
                 )
           (princ (strcat "\nTotal Area " str))
           (redraw (ssname pl 0) 4)
           )
      )
     )
     (princ)
     )

 

 

The first prompt -> Text Height

Second prompt -> polyline for main area

Third prompt - > objects to subtract

 

HTH

[Dynaformer]

Thank you all for your help! pBe's lisp is what I was looking for.

[pBe]

Thank you all for your help! pBe's lisp is what I was looking for.

 

Cool beans

 

Cheers Dynaformer

[samJ]

MEASUREGEOM

AR (FOR AREA)

O (FOR ADD)

A (FOR ADD)

(added as a macro on a shortcut key)

[justin.grant]

Wow, this is more than 10 years old, so it's probably unlikely it's still being monitored.

But, just in case..

I've been looking for a lisp where I can select a polyline, such as the outline of a building, then subtract polylines, such as stairs and elevators, and come up with a number of usable square feet.

pBe's nearly gets be there, but I'd like to have the lisp update an attribute in an existing block, in square feet.

  Any chance someone can help me out?

Thank you :)

[BIGAL]

Have you tried doing a bpoly and look at what closed plines are made. Use pick point.

[tombu]

https://autocadprojects.com/how-to-calculate-area-in-autocad/#:~:text=Invoke the 'Area' command by,in the 'Home' tab.

How to calculate the area of multiple objects in AutoCAD?

Follow these steps for How to calculate the area of multiple objects in AutoCAD.

Invoke the ‘Area‘ command by typing “AREA” in the command bar or select it from the “Measure” drop-down menu from the ‘Utilities’ panel in the ‘Home’ tab.

Then click on the ‘Object’ from the command bar and select the object or select the area by selecting the points.

Then right-click. AutoCAD will show the area.

If you want to add more object areas in that, then click on the “Add area” and select the area which you want to add.

And also, if you want to subtract an area from the previous, then click on the “Subtract area” from the command bar and select the area to subtract.

Add or Subtract area in AutoCAD

Then press the enter key. The area will be added or subtract.

[justin.grant]

Thank you BIGAL and tombu, these aren't quite what I'm looking for.  I'd like to have the area of the floor polyline, minus elevator and stair polylines, and have that total added to an existing attribute.

[BIGAL]

Need a dwg to comment.