Jump to content

Sum numbers in closed polylines (rectangles)

mdchuyen

By mdchuyen
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mdchuyen Apprentice

mdchuyen

Posted
Posted

Sum of numbers in closed polylines (rectangles) write text on the drawing, this sum text is at the center of closed polyline (rectangle). If there is no text as a number in this closed polyline (rectangle), still write the value =0

Test.dwg

Link to comment
Share on other sites
Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted

This should work

Command SNR (for Sum Numbers in Rectangles)

  

 
(vl-load-com)
 
 ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun drawText (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str))))
				 
 
;; LW Vertices  -  Lee Mac
;; Returns a list of lists in which each sublist describes
;; the position, starting width, ending width and bulge of the
;; vertex of a supplied LWPolyline
(defun LM:LWVertices ( e )
    (if (setq e (member (assoc 10 e) e))
        (cons
            (list
                (assoc 10 e)
                (assoc 40 e)
                (assoc 41 e)
                (assoc 42 e)
            )
            (LM:LWVertices (cdr e))
        )
    )
)

 
(defun getVertices ( pline / verts vert res)
	(setq verts (LM:LWVertices (entget pline) ))
	(setq res (list))
	(foreach vert verts
		(setq p (cdr (assoc 10 vert)))
		(setq res (append res (list p)))
	)
	res
)

;; returns (list min-x min-y max-x max-y)
(defun getWindow (pointlist / i min-x min-y max-x max-y)
	(setq i 0)
	(foreach point pointlist
		(if (= i 0) 
			(progn
				;; first point
				(setq min-x (nth 0 point))
				(setq min-y (nth 1 point))
				(setq max-x (nth 0 point))
			(setq max-y (nth 1 point))
			progn)
			
			(progn			
				(if (< (nth 0 point) min-x)(setq min-x (nth 0 point)))
				(if (< (nth 1 point) min-y)(setq min-y (nth 1 point)))
				(if (> (nth 0 point) max-x)(setq max-x (nth 0 point)))
				(if (> (nth 1 point) max-y)(setq max-y (nth 1 point)))
			progn)
		)
		
		(setq i (+ i 1))
	)
	(list min-x min-y max-x max-y)
)

;; Sum Numbers in Rectangles
(defun c:snr ( / pline verts window ss ss0 sum numb th i j)
	(setq th 1.0)  ;; default text height
	(setq j 0)
	(princ "\nSelect the rectangles: ")
	(setq ss0 (ssget (list (cons 0 "*POLYLINE") ) ))
	(princ (sslength ss0) )
	(repeat (sslength ss0) 
		;; (setq pline (entsel "\nSelect Rectangle: "))
		(setq pline (ssname ss0 j))
		(if pline (progn 
			(setq sum 0.0)

			(setq verts (getVertices pline))
			(setq window (getWindow verts))
			;; get all texts inside that window
			(setq ss (ssget "w" (list (nth 0 window) (nth 1 window)) (list (nth 2 window) (nth 3 window)) (list (cons 0 "TEXT") )))
			(setq i 0)
			(if ss  
				(progn
					(repeat (sslength ss)
						(princ "\n")
						(setq numb (atof (cdr (assoc 1 (entget (ssname ss i))))))
						;; sum
						(setq sum (+ sum numb))
						(princ numb)
						(setq i (+ i 1))
					)
					;; text height
					(setq th (cdr (assoc 40 (entget (ssname ss 0)))))
					(drawText 
						(list (/ (+ (nth 0 window) (nth 2 window) ) 2) (/ (+ (nth 1 window) (nth 3 window) ) 2))   
						th 
						(rtos sum 2 2)
					)
				)
				;; no text found in rectangle
				(drawText 
					(list (/ (+ (nth 0 window) (nth 2 window) ) 2) (/ (+ (nth 1 window) (nth 3 window) ) 2))   
					th 
					"0.0"
				)
			)
			(princ "\n\n")
			(princ sum)
			
		))
		(setq j (+ j 1))
	)
	(princ)
)

 

  • Like 1
Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted

You can add your text style along with the layer name to the program if you wish. 

(defun c:Test (/ int sel cad ent get 1st 2nd sum num ins txt lst dig pos )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect rectangle with four corners to count texts within : ")
       (setq int -1 sel (ssget '((0 . "LWPOLYLINE") (90 . 4))))
       (setq cad (vlax-get-acad-object))
       (or (vla-zoomExtents cad) t)
       (while (setq int (1+ int) ent (ssname sel int))
         (and (setq get (entget ent)
                    1st (assoc 10 get)
                    2nd (cdr (assoc 10 (cdr (member (assoc 10 (cdr (member 1st get))) get))))
                    )
              (setq sum 0.0 num -1 ins (ssget "_W" (setq 1st (cdr 1st)) 2nd '((0 . "TEXT"))))
              (while (setq num (1+ num) txt (ssname ins num))
                (and (setq lst (entget txt))
                     (numberp (setq dig (read (cdr (assoc 1 lst)))))
                     (setq sum (+ sum dig))
                     )
                )
              )
         (entmake (list '(0 . "TEXT") (cons 10 (setq pos (mapcar '(lambda (j k) (/ (+ j k) 2.0)) 1st 2nd)))
                        (cons 1 (if (> sum 0.0) (rtos sum 2 2) "0.00")) '(40 . 0.36)
                        (cons 11 pos) '(71 . 0) '(72 . 1) '(73 . 2)))
         )
       (vla-ZoomPrevious cad)
       )
  (princ)
  ) (vl-load-com)

 

  • Like 1
Link to comment
Share on other sites
mdchuyen Apprentice

mdchuyen

Posted
  • Author
Posted
12 hours ago, Emmanuel Delay said:

This should work

Command SNR (for Sum Numbers in Rectangles)

  

 
(vl-load-com)
 
 ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun drawText (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str))))
				 
 
;; LW Vertices  -  Lee Mac
;; Returns a list of lists in which each sublist describes
;; the position, starting width, ending width and bulge of the
;; vertex of a supplied LWPolyline
(defun LM:LWVertices ( e )
    (if (setq e (member (assoc 10 e) e))
        (cons
            (list
                (assoc 10 e)
                (assoc 40 e)
                (assoc 41 e)
                (assoc 42 e)
            )
            (LM:LWVertices (cdr e))
        )
    )
)

 
(defun getVertices ( pline / verts vert res)
	(setq verts (LM:LWVertices (entget pline) ))
	(setq res (list))
	(foreach vert verts
		(setq p (cdr (assoc 10 vert)))
		(setq res (append res (list p)))
	)
	res
)

;; returns (list min-x min-y max-x max-y)
(defun getWindow (pointlist / i min-x min-y max-x max-y)
	(setq i 0)
	(foreach point pointlist
		(if (= i 0) 
			(progn
				;; first point
				(setq min-x (nth 0 point))
				(setq min-y (nth 1 point))
				(setq max-x (nth 0 point))
			(setq max-y (nth 1 point))
			progn)
			
			(progn			
				(if (< (nth 0 point) min-x)(setq min-x (nth 0 point)))
				(if (< (nth 1 point) min-y)(setq min-y (nth 1 point)))
				(if (> (nth 0 point) max-x)(setq max-x (nth 0 point)))
				(if (> (nth 1 point) max-y)(setq max-y (nth 1 point)))
			progn)
		)
		
		(setq i (+ i 1))
	)
	(list min-x min-y max-x max-y)
)

;; Sum Numbers in Rectangles
(defun c:snr ( / pline verts window ss ss0 sum numb th i j)
	(setq th 1.0)  ;; default text height
	(setq j 0)
	(princ "\nSelect the rectangles: ")
	(setq ss0 (ssget (list (cons 0 "*POLYLINE") ) ))
	(princ (sslength ss0) )
	(repeat (sslength ss0) 
		;; (setq pline (entsel "\nSelect Rectangle: "))
		(setq pline (ssname ss0 j))
		(if pline (progn 
			(setq sum 0.0)

			(setq verts (getVertices pline))
			(setq window (getWindow verts))
			;; get all texts inside that window
			(setq ss (ssget "w" (list (nth 0 window) (nth 1 window)) (list (nth 2 window) (nth 3 window)) (list (cons 0 "TEXT") )))
			(setq i 0)
			(if ss  
				(progn
					(repeat (sslength ss)
						(princ "\n")
						(setq numb (atof (cdr (assoc 1 (entget (ssname ss i))))))
						;; sum
						(setq sum (+ sum numb))
						(princ numb)
						(setq i (+ i 1))
					)
					;; text height
					(setq th (cdr (assoc 40 (entget (ssname ss 0)))))
					(drawText 
						(list (/ (+ (nth 0 window) (nth 2 window) ) 2) (/ (+ (nth 1 window) (nth 3 window) ) 2))   
						th 
						(rtos sum 2 2)
					)
				)
				;; no text found in rectangle
				(drawText 
					(list (/ (+ (nth 0 window) (nth 2 window) ) 2) (/ (+ (nth 1 window) (nth 3 window) ) 2))   
					th 
					"0.0"
				)
			)
			(princ "\n\n")
			(princ sum)
			
		))
		(setq j (+ j 1))
	)
	(princ)
)

 

Thank you friends for supporting me. Too great

  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...