Polyline area to table

[Tomislav]

Hello everyone.

Does anyone has a lisp that does this:

First you select (it would be great to have 'pick' and 'select' options for selecting) one or more (in that case lisp sums their areas) closed polyline/s and then you select a place in table in which lisp should enter that area.

Any help is appreciated.  

[BIGAL]

Did you google there is so many pline area lisps out there.

[Dadgad]

Check LeeMacs Excellent Area lisps, of which there are a few.

 

http://www.lee-mac.com/programs.html#general

 

Thanks Lee! 

[Tomislav]

Hello, yes I did search for it and I have all the Lee's lisps, but that is not quite that.

[BIGAL]

So what is the problem or is it you want some one to do all the work for you ?

 

What do you have already that does not work and why. Getting total area is just adding areas into a variable.

[Tomislav]

First of all, I do all the lisps I can myself and I made over 50 of them, and the problem here is populating one place in table. That I don't know how to do and tight schedule right now.

And secondly, I didn't know there is a rule you can't ask if someone has that lisp when 90% of the people here do it and I don't have a problem with their requests and will help them if I can.

But, nevermind my question, I'll do it myself somehow, thanks for your help Bigal.

Edited March 17, 2021 by Tomislav

[rlx]

maybe this can help you one step along the road :

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/select-a-cell-in-a-table/td-p/2892638

[harshadp86]

OK this is something i already have for perimeter so i convert it for area.

 try and check .

AEXPXL.Lsp

[harshadp86]

(defun C:AEXPXL ( / ss lst fname fil sel2lst)
  (defun sel2lst ( sel / l len )
  (if (= 'PICKSET (type sel))
    (repeat (setq len (sslength sel))
      (setq len (1- len)
            l   (cons (ssname sel len) l)
      ) ;setq
    ) ;repeat
  ) ;if
)
  (setvar "CMDECHO" 0)
  (princ "\nSelect Circle,Polyline,Ellipse,Spline or Region")
  (if
    (and
      (setq ss (ssget '((0 . "CIRCLE,*POLYLINE,ELLIPSE,REGION,SPLINE"))))
      (setq lst (sel2lst ss))
      (setq fname (getfiled "Select Excell file" "" "xls" 1))
      )
    (progn
      (setq fil (open fname "w"))
      (write-line "Object\tArea" fil)
      (foreach en lst
        (command "_AREA" "_Object" en)
        (write-line (strcat (cdr(assoc 0 (entget en)))"\t" (rtos (getvar "AREA") 2 12)) fil)
        )
      (close fil)
      (princ "\nArea of ")(princ (length lst))
      (princ " object export to ")(princ fname)
      )
    )
  (princ)
  )
(princ "\nType AEXPXL to run") 
 
     

try this

[Tomislav]

5 hours ago, rlx said:

maybe this can help you one step along the road :

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/select-a-cell-in-a-table/td-p/2892638

 

thank you rlx, that is of great help....and thank you harshadp86 for your lisp, although I need to populate table cell in drawing and not Excel...

[Tomislav]

ok, so I've patched something up but it's inconsistent with filling the right cell and I also can't pick inside cell but at the edge, so can someone explain what should I use to pick inside cell

(defun c:ACPTC (/ File f PlineSelSet PlineArea)

  (defun *error* (emsg)
    (if (or (= emsg "quit / exit abort")
            (= emsg "bad argument type: lselsetp nil")
        ) ;_  or
      (princ)
      (princ emsg)
    ) ;_  if
    (setvar 'OSMODE osm)
    (setvar 'CMDECHO cmd)
    (gc)
  ) ;_  defun


  (setq cmd (getvar 'CMDECHO)
        osm (getvar 'OSMODE)
  ) ;_  setq
  (setvar 'CMDECHO 0)
  (setvar 'OSMODE 0)

  (vl-load-com)
  (while
    (setq PlineSelSet (ssadd (car (entsel "\nSelect a Closed Polyline for Area Calculation "))))
    (command "._area" "O" PlineSelSet)
    (setq PlineArea (atof(rtos(getvar "area")2 2)))
    (setq AreaLayer (cdr (assoc 8 (entget (ssname PlineSelSet 0)))))
    (setq ent(entsel "\nSelect table cell to fill with area value!"))
    (vla-HitTest
      (vlax-ename->vla-object (car ent))
      (vlax-3d-point (cadr ent))
      (vlax-3d-point (trans (getvar 'ViewDir) 1 0))
      'outRow
      'outCol
      )
    (princ outRow)
    (princ outCol)
    (setq MyTable(vlax-ename->vla-object (car ent)))
    (setq sID1 (vla-CreateContent MyTable outRow outCol 0))
    (vla-SetTextString MyTable outRow outCol sID1 PlineArea)
    (vla-Regen doc :vlax-true)
  ) ; while


) ; Defun

(princ "\nArea of closed polylines to table cell...Type ACPTC")


;|«Visual LISP© Format Options»
(100 2 1 2 T " " 100 6 0 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;

 

[BIGAL]

Ok I apologise just see so many times do it for me, but your having a go, if your happy can provide code for pick location for table and make a header, and title row, pick pline then use INSERTROWS function and add rows as required, this could be 1 by 1 or pick lots of plines. Happy to provide example code.

 

As a side answer table cells can have a field as an answer so if change pline shape will update.

[Tomislav]

9 hours ago, BIGAL said:

Ok I apologise just see so many times do it for me, but your having a go...

no problem...

 

I don't need to make table cause I have premade tables. I only need to pick closed polyline/s for reading area and then pick specific cell in table to insert it there (don't want to create new table or rows)..

This lisp I made reads area and asks to select cell but you can't select it like picking in cell but selecting cell wall and depending what part of wall you pick, it puts data in different cell.

That's why I print to command line their value to track what's going on but can't find out what's it doing.

So I need like a function 'Put value in cell' that must be made in ActiveX cause you can't work with tables in lisp, and I am very bad in ActiveX (just don't understand the logic of it) so I'm guessing with my code...

[BIGAL]

Something like this

 

;; Example shows how to pick a single table cell on screen and change its value.
;; This example demonstrates the ActiveX properties/methods HitTest,
;; GetCellType, GetText and SetText.
; original code by Lee Ambrosius 2015

(defun c:SelectTableCell ( / pick vHeight vWidth lwrLeft uprRight vector
                                           SS_TABLES cnt eMax tableObj row col cellValueOrg)
  
  ;; Ask the user for a point on screen
  (if (/= (setq pick (vlax-3d-point (getpoint "\nSelect Cell to edit: "))) nil)
    (progn

      ;; Get the corners of the screen display to build our selection set
      (setq vHeight (getvar "viewsize"))
      (setq vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight))

      (setq lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight  2)) 0))
      (setq uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight  2)) 0))

      ;; Get the current display orientation
      (setq vector (vlax-make-safearray vlax-vbDouble '(0 . 2)))
      (vlax-safearray-fill vector '(1 1 1))
      (setq vector (vlax-make-variant vector))
      
      ;; Select all the table objects visible on screen
      (if (setq SS_TABLES (ssget "C" lwrleft uprright (list (cons 0 "ACAD_TABLE"))))
        (progn
   
          (setq cnt 0
                eMax (sslength SS_TABLES)
          )

          ;; Step through all the items in the selection set
          (while (> eMax cnt) 
            ;; Geta table object from the selection set
            (setq tableObj (vlax-ename->vla-object (ssname SS_TABLES cnt)))
  
            ;; Return values for what cell was picked in
            (setq row 0
                  col 0)

                 
            ;; Check to see if a valid cell was picked
            (if (= (vla-hittest tableObj pick vector 'row 'col) :vlax-true)
              (progn

                ;; Get out of the loop
                (setq cnt (1+ eMax))
  
                ;; Check to see what the Cell Type is (Text or Block)
                (if (= (vla-GetCellType tableObj row col) acTextCell)
                  (progn
                    ;; Let's get the value out
                    (setq cellValueOrg (vla-GetText tableObj row col))

                    ;; Change the current value
                    (vla-SetText tableObj row col "Revised Text")
                    (vla-Update tableObj)
                    (alert "Cell text was changed.")
          
                    ;; Restore the original value
                    (vla-SetText tableObj row col cellValueOrg)
                    (vla-Update tableObj)
                    (alert "Cell text was changed back to the original value.")
                    (setq cnt eMax)
                  )
                )
              )
            )
            (setq cnt (1+ cnt))
          )
        )
      )
    )
  )
 (princ)

 

[Tomislav]

That's it!

Jesus, all that programming to change cell value...guess they couldn't make it more difficult..

I could not make that on my own. Now I'll have to modify it to my lisp.

Thanks a lot Bigal 

[BIGAL]

You can remove a lot of the code but you will need to pick the table still for the hittest, either do at start check is tableobj nil then pick table, note you will have to reset tableobj to nil to select another table.

[Tomislav]

here it is...don't know why to reset table when it works with more tables?

 

(defun c:ACPTC (/ File f PlineSelSet PlineArea)


  (defun SelectTableCell (area /
			  pick
			  vHeight
			  vWidth
			  lwrLeft
			  uprRight
			  vector
			  SS_TABLES
			  cnt
			  eMax
			  tableObj
			  row
			  col
			  cellValueOrg
			  )

  ;; Ask the user for a point on screen
  (if
    (/=	(setq pick (vlax-3d-point (getpoint "\nSelect Cell to enter Area: ")))
	nil
	)
     (progn

       ;; Get the corners of the screen display to build our selection set
       (setq vHeight (getvar "viewsize"))
       (setq vWidth (* (/ (nth 0 (getvar "screensize"))
			  (nth 1 (getvar "screensize"))
			  )
		       vHeight
		       )
	     )

       (setq lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2))
			   (- (nth 1 (getvar "viewctr")) (/ vHeight 2))
			   0
			   )
	     )
       (setq
	 uprRight (list	(+ (nth 0 (getvar "viewctr")) (/ vWidth 2))
			(+ (nth 1 (getvar "viewctr")) (/ vHeight 2))
			0
			)
	 )

       ;; Get the current display orientation
       (setq vector (vlax-make-safearray vlax-vbDouble '(0 . 2)))
       (vlax-safearray-fill vector '(1 1 1))
       (setq vector (vlax-make-variant vector))

       ;; Select all the table objects visible on screen
       (if (setq SS_TABLES (ssget "C"
				  lwrleft
				  uprright
				  (list (cons 0 "ACAD_TABLE"))
				  )
		 )
	 (progn

	   (setq cnt  0
		 eMax (sslength SS_TABLES)
		 )

	   ;; Step through all the items in the selection set
	   (while (> eMax cnt)
             
	     ;; Get table object from the selection set
	     (setq tableObj(vlax-ename->vla-object (ssname SS_TABLES cnt)))

	     ;; Return values for what cell was picked in
	     (setq row 0
		   col 0
		   )

	     ;; Check to see if a valid cell was picked
	     (if (= (vla-hittest tableObj pick vector 'row 'col)
		    :vlax-true
		    )
	       (progn

		 ;; Get out of the loop
		 (setq cnt (1+ eMax))

		 ;; Check to see what the Cell Type is (Text or Block)
		 (if (= (vla-GetCellType tableObj row col) acTextCell)
		   (progn
		     ;; Change the current value
		     (vla-SetText tableObj row col area)
		     (vla-Update tableObj)
		     (setq cnt eMax)
		     )
		   )
		 )
	       )
	     (setq cnt (1+ cnt))
	     )
	   )
	 )
       )
     )
  (princ)
  )


  

  (defun *error* (emsg)
    (if (or (= emsg "quit / exit abort")
            (= emsg "bad argument type: lselsetp nil")
        ) ;_  or
      (princ)
      (princ emsg)
    ) ;_  if
    (setvar 'OSMODE osm)
    (setvar 'CMDECHO cmd)
    (gc)
  ) ;_  defun


  (setq cmd (getvar 'CMDECHO)
        osm (getvar 'OSMODE)
  ) ;_  setq
  (setvar 'CMDECHO 0)
  (setvar 'OSMODE 0)

  (vl-load-com)
  (while
    (princ"\nSelect a Closed Polyline for Area Calculation ")
    (setq poly(ssget '((0 . "LWPOLYLINE,POLYLINE"))))
    (setq cnt 0
          area 0)
    (repeat(sslength poly)
      (setq ename(ssname poly cnt))
      (setq ent(vlax-ename->vla-object ename))
      (setq area(+ area (vla-get-Area ent)))
      (setq cnt(1+ cnt))
      )
    (SelectTableCell (atof(rtos area 2 2)))
    )

) ; Defun

(princ "\nArea of closed polylines to table cell...Type ACPTC")


;|«Visual LISP© Format Options»
(100 2 1 2 T " " 100 6 0 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;