Lisp that displays the sum of numbers for each layer as a table

[jukk08]

hello. I am studying lisp and would like to ask for help.

 

 

There are numbers(mtext) assigned to different layers.

 

 

I want to sum these numbers by the same layer.

ex)  Layer   /  Contents

          AA     /     1.5                                                      AA   /   2.5

          AA     /     1.0                          =>                        BB   /   2.0

          BB     /     2.0

 

 

ITEM cells should always be marked as PIPE.

 

 

A sample drawing&LISP is attached.

 

 

Thanks in advance and please help.

 

P.S A reference LISP I stumbled across the Internet. A big thank you to the creators.

SAMPLE.dwg textcount.lsp

[Emmanuel Delay]

You can make an associated list  (list (cons layer_name sum) ... )

 

sum_by_layer holds that value.

Can you take it from here (I haven't looked at generating tables in a while)?  Need extra help?

 

;; command CMBL for Count Mtext By Layer
(defun c:cmbl ( / ss i layer val subvalue sum_by_layer)
	;; user selects Mtext objects
	(setq ss (ssget (list (cons 0 "MTEXT"))))

	;; associated list. (list (cons layer_name sum) ... )
	(setq sum_by_layer (list))
	
	(setq i 0)
	(repeat (sslength ss)
		;; read the layer name and value.
		(setq layer (cdr (assoc 8 (entget (ssname ss i)))))
		(setq val (cdr (assoc 1 (entget (ssname ss i)))))
		;; check if that value is a number.  If there's anything else than a number we'll skip it
		(if (> (atof val) 0.0)
			(progn
				;; check if that layer already has an associated sub sum
				(if (assoc layer sum_by_layer) 
					(progn
						;; 
						(setq subsum (cdr (assoc layer sum_by_layer)))	;; read the already present value
						(setq subsum (+ subsum (atof val)))				;; add new value
						
						;; now substitute the assoc value   ...  (subst new old list)
						(subst (cons layer subsum) (assoc layer sum_by_layer) sum_by_layer )
					)
					(progn
						;; add that layer-value couple to the list
						(setq sum_by_layer (append sum_by_layer (list (cons layer (atof val)))))
					)
				)
			)
			(progn
			)
		)
		
		(setq i (+ i 1))
	)
	
	(princ sum_by_layer)
	(princ)
)

 

[jukk08]

TO. Emmanuel Delay

 

Thank you very much for your reply.

 

But I want it to be written in a table like the attached drawing and lisp.

 

Table lisp is too difficult for me.

 

Can you help me?

[mhupp]

If i remember correctly @exceed had a lisp that would update a table but can't seem to find the post. maybe if they could post the code for you to study.

[jukk08]

TO.mhupp

 

Thank you very much for your reply.

 

I'll look for it:)

[Emmanuel Delay]

If you're happy with this, Retable, by @exceed

 

Then you can do this, then RETABLE it.

 

(defun drawText (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str)))
)

;; command CMBL for Count Mtext By Layer
(defun c:cmbl ( / ss i layer val subvalue sum_by_layer xy x y pt hgt rowhgt str)
	;; user selects Mtext objects
	(setq ss (ssget (list (cons 0 "MTEXT"))))

	;; associated list. (list (cons layer_name sum) ... )
	(setq sum_by_layer (list))
	
	(setq i 0)
	(repeat (sslength ss)
		;; read the layer name and value.
		(setq layer (cdr (assoc 8 (entget (ssname ss i)))))
		(setq val (cdr (assoc 1 (entget (ssname ss i)))))
		;; check if that value is a number.  If there's anything else than a number we'll skip it
		(if (> (atof val) 0.0)
			(progn
				;; check if that layer already has an associated sub sum
				(if (assoc layer sum_by_layer) 
					(progn
						;; 
						(setq subsum (cdr (assoc layer sum_by_layer)))	;; read the already present value
						(setq subsum (+ subsum (atof val)))				;; add new value
						
						;; now substitute the assoc value   ...  (subst new old list)
						(subst (cons layer subsum) (assoc layer sum_by_layer) sum_by_layer )
					)
					(progn
						;; add that layer-value couple to the list
						(setq sum_by_layer (append sum_by_layer (list (cons layer (atof val)))))
					)
				)
			)
			(progn
			)
		)
		
		(setq i (+ i 1))
	)
	
	(princ sum_by_layer)
	
	;;;; Table
	(setq xy (getpoint "\nTable position: "))
	(setq x (nth 0 xy))
	(setq y (nth 1 xy))
	
	(setq hgt 2.5)	;; text height
	(setq rowhgt 8)	;; row height
	
	;;  
	(drawText (list (+ x 24.0) y) hgt "COUNT")
	(setq y (- y  rowhgt))
	
	(drawText (list x y) hgt "ITEM")
	(drawText (list (+ x 24.0) y) hgt "LAYER")
	(drawText (list (+ x 60.0) y) hgt "QTY")
	(drawText (list (+ x 80.0) y) hgt "DESCRIPTION")
		
	(foreach row sum_by_layer
		(setq y (- y  rowhgt))
		(drawText (list x y) hgt "PIPE")
		(drawText (list (+ x 24.0) y) hgt (car row))
		(drawText (list (+ x 60.0) y) hgt (rtos (cdr row) 2 2))
		(drawText (list (+ x 80.0) y) hgt ".")
	)
	
	(princ)
)

 

[mhupp]

The one was thinking of took a existing table and remade it.

[BIGAL]

Making the table brand new is easiest approach if you add some items run again and create a new table, yes can update an existing tabel but lots more work.

 

Here is a make table example. You need the VL-insertrows command to add your cable answers.

 

 

 

; Example of how to create an Autocad Table
; By Alan H 

(defun AHMaketable (/ colwidth numcolumns numrows objtable rowheight sp vgad vgao vgms)
(vl-load-com)
(setq sp (vlax-3d-point (getpoint "\nPick point for table")))
(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq numrows 5)
(setq numcolumns 5)
(setq rowheight 2.5)
(setq colwidth 60)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "DRAWING REGISTER")
(vla-settext objtable 1 0 "DRAWING NUMBER")
(vla-settext objtable 1 1 "DRAWING TITLE")
(vla-settext objtable 1 2 "C")
(vla-settext objtable 1 3 "D")
(vla-settext objtable 1 4 "E")
(vla-settext objtable 2 0 "1")
(vla-settext objtable 3 0 "2")
(vla-settext objtable 4 0 "3")
(command "_zoom" "e")
(princ)
)
(AHMaketable)

(setq numrows (1+ numrows)) 
(vla-InsertRows Objtable  numrows (vla-GetRowHeight Objtable (1- numrows)) 1)

(vla-Settext Objtable  numrows 0 (nth 1 cell))
(vla-Settext Objtable  numrows 1 "Line" )
(vla-Settext Objtable  numrows 2 (nth 0 cell) )
(vla-Settext Objtable  numrows 3 (strcat (rtos (nth 2  cell) 2 1) " m"))

 

[jukk08]

TO. BIGAL

 

Thank you very much for your reply.

 

I will try to refer to your answer.