mdchuyen Posted May 22, 2023 Posted May 22, 2023 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 Quote
Emmanuel Delay Posted May 22, 2023 Posted May 22, 2023 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) ) 1 Quote
Tharwat Posted May 22, 2023 Posted May 22, 2023 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) 1 Quote
mdchuyen Posted May 23, 2023 Author Posted May 23, 2023 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 1 Quote
Recommended Posts
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.