a lisp to calculate similar shapes areas

[rabeekad]

Please, i need a lisp to calculate the total area of all the similar shapes like circular or rectangular shapes or combined shapes and any closed polyline shape, I mean: when u select assume a rectangle of dim(3,5) so it will give us the total number of all the rectangles having dim(3,5) and then give us the total summation area to all of the same dimensions of dim(3,5), so it says for example: you have 6 shapes of total area= 90 m2 , so anybody can help plz

[ASMI]

Here the simplified algorithm of definition of identity of figures, but in most cases it should work.

 

(defun c:simar(/ cSet cCnt sPl dLst cAre cDis)

 (vl-load-com)

 (defun DistList(DxfList / pLst)
   (setq pLst(mapcar 'cdr (vl-remove-if-not
	       '(lambda(x)(= 10(car x)))
	       (entget DxfList))))
     (vl-sort
(mapcar 'distance pLst
		  (append(cdr pLst)
			   (list(last pLst))))'<)
   ); end of DistList

 (if
   (and
     (setq sPl(entsel "\nSelect sample polyline > "))
     (= "LWPOLYLINE"
 (cdr(assoc 0(entget(setq sPl(car sPl))))))
     ); end and
   (progn
     (setq sAre(vlax-curve-GetArea sPl)
    cCnt 0
    dLst(DistList sPl)
    ); end setq
     (if
       (setq cSet(ssget "_X" '((0 . "LWPOLYLINE"))))
 (progn
         (foreach c(vl-remove-if 'listp
	      (mapcar 'cadr(ssnamex cSet)))
      (setq cAre(vlax-curve-GetArea c)
	    cDis(DistList c)
	    ); end setq
    (if(and
	 (equal sAre cAre 0.0001)
	 (vl-every '(lambda(a b)
		      (equal a b 0.0001))dLst cDis)
	 ); and end
       (setq cCnt(1+ cCnt))
       (ssdel c cSet)
      ); end if
    ); end foreach
  (princ(strcat "\n" (itoa cCnt) " x "
	       (rtos(/ sAre 1000000)) " = "
	       (rtos(* cCnt(/ sAre 1000000)))" m2"))
  (sssetfirst nil cSet)
  ); end progn
       ); end if
     ); end progn
   (princ "\n<!> It isn't LwPolyline <!> ")
   ); end if
 (princ)
 ); end of c:simar

[rabeekad]

Thank you very much for the lisp "simar" it is very good but it is not assuming a rectangle @2000,1000 and a rectangle @1000,2000 a similar, so when I select anyone of these “knowing that these are similar dimensions” so it says: 1 x 2.000 = 2.000 m2 but didn’t add them together,because it should say: 2 x 2.000 = 4.000 m2 , your lisp applied on many shapes except if we have a rectangle and another one but in its vertical direction like my example, also please try it with an inclined rectangles of similar dimension and see what’s the output, plz draw one vertical and one horizontal and one inclined rectangle of same dimension and see whats giving me output, so would you please modify, thanks again for help and sorry for bothering

[rabeekad]

plz, i need also the lisp to apply for similar circles if you dont mind, thank you very much

[ASMI]

Thank you very much for the lisp "simar" it is very good but it is not assuming a rectangle @2000,1000 and a rectangle @1000,2000 a similar, so when I select anyone of these “knowing that these are similar dimensions” so it says: 1 x 2.000 = 2.000 m2

 

Ok. There was a small bug. And also works with the circles now.

 

(defun c:simar(/ cSet cCnt cShp sPl dLst cAre cDis)

 (vl-load-com)

 (defun DistList(DxfList / pLst)
   (setq pLst(mapcar 'cdr (vl-remove-if-not
	       '(lambda(x)(= 10(car x)))
	       (entget DxfList))))
     (vl-sort
(mapcar 'distance pLst
		  (append(cdr pLst)
			   (list(car pLst))))'<)
   ); end of DistList

 (if
   (and
     (setq sPl(entsel "\nSelect sample polyline or circle > "))
     (member (setq cShp(assoc 0(entget(setq sPl(car sPl)))))
      (list(cons 0 "LWPOLYLINE")(cons 0 "CIRCLE")))
     ); end and
   (progn
     (setq sAre(vlax-curve-GetArea sPl)
    cCnt 0
    dLst(DistList sPl)
    ); end setq
     (if
       (setq cSet(ssget "_X" (list cShp)))
 (progn
         (foreach c(vl-remove-if 'listp
	      (mapcar 'cadr(ssnamex cSet)))
      (setq cAre(vlax-curve-GetArea c)
	    cDis(DistList c)
	    ); end setq
    (if(and
	 (equal sAre cAre 0.000001)
	 (if(equal (cons 0 "LWPOLYLINE")cShp)
	 (vl-every '(lambda(a b)
		      (equal a b 0.000001))dLst cDis)
	   T
	   ); end if
	 ); and end
       (setq cCnt(1+ cCnt))
       (ssdel c cSet)
      ); end if
    ); end foreach
  (princ(strcat "\n" (itoa cCnt) " x "
	       (rtos(/ sAre 1000000)) " = "
	       (rtos(* cCnt(/ sAre 1000000)))" m2"))
  (sssetfirst nil cSet)
  ); end progn
       ); end if
     ); end progn
   (princ "\n<!> It isn't LwPolyline or Circle <!> ")
   ); end if
 (princ)
 ); end of c:simar