LISP to get a retangular area by diagonal

[gustavobernardi]

Hi.

I Have a lisp to capture a rectangular area by diagonal using the Autocad default green transparent markup.

The lisp catches and draw the first rectangle, but what I want to is continuing the application taking other rectangles but showing the markups in the screen. Actually, I take the first rectangle and, in the sequence, I draw the others, point by point.

(defun c:RETANGULAREA(/ pt1 pt2 pt3 pt4)
(setq pt1(getpoint "\nPonto inicial"))
(initget 32)
(setq pt3(getpoint PT1 "\nPonto final"))
(setq Pt2 (list (car PT1)(cadr pt3) 0))
(setq Pt4 (list (car PT3)(cadr pt1) 0))
(command ".area" "ADD" PT1 PT2 PT3 PT4 "")
(princ)
)

If I put a while, ok, it works but not stay on the screen the transparent green:

(defun c:RETANGULAREA(/ pt1 pt2 pt3 pt4)
(setq areasum 0)
(while
(setq pt1(getpoint "\nPonto inicial"))
(initget 32)
(setq pt3(getpoint PT1 "\nPonto final"))
(setq Pt2 (list (car PT1)(cadr pt3) 0))
(setq Pt4 (list (car PT3)(cadr pt1) 0))
(command "._area" PT1 PT2 PT3 PT4 "")
(setq areatosum (getvar "area"))
(setq areasum (+ areasum areatosum))
(PRINC (RTOS AREASUM))
)
(princ)
)

TIA

[dbhunia]

Hi

Do you want this.....

(defun c:RETANGULAREA(/ pt1 pt2 pt3 pt4)
(setq areasum 0)
(setq sel1 (ssadd))
(while
(setq pt1(getpoint "\nPonto inicial"))
(initget 32)
(setq pt3(getpoint PT1 "\nPonto final"))
(setq Pt2 (list (car PT1)(cadr pt3) 0))
(setq Pt4 (list (car PT3)(cadr pt1) 0))
(command "._area" PT1 PT2 PT3 PT4 "")
(setq areatosum (getvar "area"))
(setq areasum (+ areasum areatosum))
(PRINC (RTOS AREASUM))
(command "._RECTANG" pt1 pt3)
(command "_change" (entlast) "" "p" "c" 3 "")
(setq ent (entlast))
(setq sel1 (ssadd ent sel1))
)
(command "_.erase" sel1 "")
(princ)
)

[ronjonp]

Try this:

(defun c:retangularea (/ a pt1 pt2)
  (setq areasum 0)
  (while (setq pt1 (getpoint "\nPonto inicial"))
    (initget 32)
    (setq pt2 (getcorner pt1 "\nPonto final"))
    ;; Subtract x's & y's
    (setq a (mapcar '- pt1 pt2))
    ;; Multiply x and y to get area of rectangle
    (setq areasum (+ areasum (abs (* (car a) (cadr a)))))
    (print (rtos areasum))
  )
  (princ)
)

[gustavobernardi]

Hi dbhunia, thank for answering.

Not exactly, I was wanting to use the default graphics of the AutoCAD, without drawing any object.

[ronjonp]

Being that the selection area goes away when enter is pressed I don't think you can show multiple areas at the same time using that method.

[dbhunia]

ok

Like this....

(defun c:RETANGULAREA(/ pt1 pt2 pt3 pt4)
(setq areasum 0)
(while
(setq pt1(getpoint "\nPonto inicial"))
(initget 32)
(setq pt3(getcorner PT1 "\nPonto final"))
(setq Pt2 (list (car PT1)(cadr pt3) 0))
(setq Pt4 (list (car PT3)(cadr pt1) 0))
(command "._area" PT1 PT2 PT3 PT4 "")
(setq areatosum (getvar "area"))
(setq areasum (+ areasum areatosum))
(PRINC (RTOS AREASUM))
)
(princ)
)

[gustavobernardi]

Yes I also think that is not possible, but I tried just in case... 

I think I will keep the first version, when I catch the first rectangle with diagonal and the others with poligonal method.

Than you!

[ronjonp]

Doubled up post..

[ronjonp]

Try this 🙂

(defun c:retangularea (/ *error* a a2 b e p1 p2)
  ;; RJP » 2018-11-07
  (defun *error* (msg)
    (and b (mapcar 'entdel b))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))
    (princ)
  )
  (if (null (tblobjname "block" "sel"))
    (progn (entmake '((0 . "BLOCK")
		      (100 . "AcDbEntity")
		      (67 . 0)
		      (8 . "0")
		      (100 . "AcDbBlockReference")
		      (2 . "sel")
		      (10 0.0 0.0 0.0)
		      (70 . 0)
		     )
	   )
	   (entmake '((0 . "LWPOLYLINE")
		      (100 . "AcDbEntity")
		      (67 . 0)
		      (8 . "0")
		      (62 . 3)
		      (440 . 33554495)
		      (100 . "AcDbPolyline")
		      (90 . 2)
		      (70 . 128)
		      (43 . 1.0)
		      (38 . 0.0)
		      (39 . 0.0)
		      (10 0.0 -0.5)
		      (40 . 1.0)
		      (41 . 1.0)
		      (42 . 0.0)
		      (91 . 0)
		      (10 0.0 0.5)
		      (40 . 1.0)
		      (41 . 1.0)
		      (42 . 0.0)
		      (91 . 0)
		     )
	   )
	   (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
    )
  )
  (setq a2 0)
  (while (setq p1 (getpoint "\nPonto inicial"))
    (initget 32)
    (setq p2 (getcorner p1 "\nPonto final"))
    ;; Subtract x's & y's
    (setq a (mapcar 'abs (mapcar '- p1 p2)))
    ;; Multiply x and y to get area of rectangle
    (setq a2 (+ a2 (* (car a) (cadr a))))
    (if	(setq e	(entmakex (list	'(0 . "INSERT")
				'(8 . "TempSelection")
				'(2 . "sel")
				(cons 10 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.)))
				(cons 41 (car a))
				(cons 42 (cadr a))
				'(43 . 1.0)
				'(50 . 0.0)
			  )
		)
	)
      (setq b (cons e b))
    )
    (print (rtos a2))
  )
  (and b (mapcar 'entdel b))
  (princ)
)

[ВeekeeCZ]

Same idea as @ronjonp, a bit simpler with solids. 

(defun c:RETANGULAREA(/ pt1 pt2 pt3 pt4 ss)
  (setq areasum 0
	ss (ssadd))
  (while
    (setq pt1 (getpoint "\nPonto inicial"))
    (initget 32)
    (setq pt3 (getpoint PT1 "\nPonto final"))
    (setq Pt2 (list (car PT1) (cadr pt3) 0))
    (setq Pt4 (list (car PT3) (cadr pt1) 0))
    (command "._area" "_non" PT1 "_non" PT2 "_non" PT3 "_non" PT4 "")
    (command "._solid" "_non" PT1 "_non" PT4 "_non" PT2 "_non" PT3 "")
    (ssadd (entlast) ss)
    (setq areatosum (getvar "area"))
    (setq areasum (+ areasum areatosum))
    (PRINC (RTOS AREASUM))
    )
    (command "_.erase" ss "")
  (princ)
  )

.... sure the 'CECOLOR should be 84 or similar, but you can manage that...