### Author Topic: How to start this lisp to sum numbers in each row?  (Read 1637 times)

0 Members and 1 Guest are viewing this topic.

• Swamp Rat
• Posts: 1337
##### How to start this lisp to sum numbers in each row?
« on: June 15, 2019, 08:49:38 AM »
Hi,
How to start this lisp to sum numbers in each row?
As attached
Thanks

#### Lee Mac

• Seagull
• Posts: 12397
• London, England
##### Re: How to start this lisp to sum numbers in each row?
« Reply #1 on: June 15, 2019, 09:12:30 AM »
Is the text on the left of your image represented by individual text objects or an AutoCAD table?

• Swamp Rat
• Posts: 1337
##### Re: How to start this lisp to sum numbers in each row?
« Reply #2 on: June 15, 2019, 09:17:47 AM »
It is Text objects

#### Lee Mac

• Seagull
• Posts: 12397
• London, England
##### Re: How to start this lisp to sum numbers in each row?
« Reply #3 on: June 15, 2019, 11:50:47 AM »
I would approach it this way:
• Make a selection of all text objects
• Iterate over the selection and create a list of the insertion point & content of each object
• Group the list by items with equal y-coordinate
• Sort each group by ascending x-coordinate
• Test whether the content of the first item in each group matches "F*"
• If so, sum the numerical content of the remaining items in the group.

• Swamp Rat
• Posts: 1337
##### Re: How to start this lisp to sum numbers in each row?
« Reply #4 on: June 16, 2019, 09:51:08 AM »
I would approach it this way:
• Make a selection of all text objects
• Iterate over the selection and create a list of the insertion point & content of each object
• Group the list by items with equal y-coordinate
• Sort each group by ascending x-coordinate
• Test whether the content of the first item in each group matches "F*"
• If so, sum the numerical content of the remaining items in the group.

This is what I ended up too but Sorting is out of my mind
Code - Auto/Visual Lisp: [Select]
1. (Defun c:SumTbl (/ ent     enth    entl    entp    entps   entpx
2.                    entpy   ents    entsm   entsps  entspx  entspxs
3.                    entspy  entspys i       ss      sum     sump
4.                  doc)
5.
6.
7.   (setq entsPX nil)
8.   (setq entsPY nil)
9.   (setq entsPS nil)
10.   (setq entsPXs nil)
11.   (setq entsPYs nil)
12.
13.   (if (setq ss (ssget '( (0 . "text"))))
14.     (repeat (setq i (sslength ss))
15.       (setq ent (entget (ssname ss (setq i (1- i)))))
16.       (setq entS (cdr (assoc 1 ent)))
18.           (setq entPS (list entP entS))
19.           (setq entsPS (cons entPS entsPS))
20.
21.           (setq entL (cdr (assoc 08 ent)))
22.           (setq entH (cdr (assoc 40 ent)))
23.
24.           (setq entP (cdr (assoc 10 ent)))
25.           (setq entPX (nth 0 entP))
26.           (setq entPY (nth 1 entP))
27.
28.           (SETQ entSm (atoi sum))
29.           (setq sumP (list (+ entPX (* 3 entH))  entPY))
30.           (MakeText entSm sumP entL entH 0 0 1 )
31.           )
32.         )
33.       )
34.     )
35.   (PRINC)
36.   )
37.
38. (defun MakeText (str pt lyr ht ro G72 G73)
39.   (entmakex (list (cons 0 "TEXT")       ;***
40.                  (cons 1 str)           ;* (the string itself)
41.                  (cons 6 "BYLAYER")     ; Linetype name
42.                  (cons 8 lyr)           ; layer
43.                  (cons 10 pt)           ;* First alignment point (in OCS)
44.                  (cons 11 pt)           ;* Second alignment point (in OCS)
45.                  (cons 39 0.0)          ; Thickness (optional; default = 0)
46.                  (cons 40 ht)           ;* Text height
47.                  (cons 41 1.0)          ; Relative X scale factor, Width Factor, defaults to 1.0
48.                  (cons 50 ro)           ; Text rotation angle
49.                  (cons 51 0.0)          ; Oblique angle
50.                  (cons 62 256)          ; color
51.                  (cons 71 0)            ; Text generation flags
52.                  (cons 72 G72)          ; Horizontal text justification type
53.                  (cons 73 G73)          ; Vertical text justification type
54.                  (cons 210 (list 0.0 0.0 1.0)))))
55.
56. (defun *error* ( msg )
57.   (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")))
58.     (princ (strcat "\nError: " msg))
59.     )
60.   (princ)
61.   )
62.

#### BIGAL

• Swamp Rat
• Posts: 538
• 30 + years of using Autocad
##### Re: How to start this lisp to sum numbers in each row?
« Reply #5 on: June 19, 2019, 12:59:00 AM »
You can sort lists multi level deep not just x y, and  you could sort rows that have 1 2 10 texts. It would have ((x y text) (x y text)…….

This is not finished but close, hansacad not sure how you want to do the answers.

178
46
213

Code: [Select]
`(defun checkstr ( )(setq tot 0)(repeat (setq y (length lst2))(setq strsub (nth (setq y (- y 1)) lst2))(if (= (wcmatch strsub "*[A-z]*") T)(princ)(setq tot (+ (atof strsub) tot))))(alert (strcat "tot = " (rtos tot 2 3))))(defun ahtest ( / ss obj pt ptx pty str )(setq ss (ssget (list (cons 0 "*text"))))(setq lst '())(repeat (setq x (sslength ss))(setq obj (entget (ssname ss (setq x (- x 1)))))(setq pt (cdr (assoc 10 obj)))(setq ptx (nth 0 pt)      pty (nth 1 pt))(setq str (cdr (assoc 1 obj)))(setq lst (cons (list ptx pty str) lst))); sorts on 1st two items(setq lst (vl-sort lst '(lambda (x y)(cond((= (cadr x)(cadr y))(< (car x)(car y)))((< (cadr x)(cadr y))))))); now make sublist row at a time by comparing (nth 1 str) value(setq x 0)(setq lst2 '())(setq str1 (nth x lst))(repeat (-(length lst) 1)(setq str2 (nth (setq x (+ x 1)) lst))(setq y1 (nth 1 str1))(setq y2 (nth 1 str2))(if (= y1 y2)(progn(setq lst2(cons (nth 2 str1) lst2))(setq str1 str2))(progn(setq lst2(cons (nth 2 str1) lst2))(setq str1 str2)(princ lst2)(checkstr)(if (= x (length lst))(princ)(setq lst2 '())))))(setq lst2(cons (nth 2 str1) lst2))(checkstr)(princ))(ahtest)`
« Last Edit: June 19, 2019, 03:12:07 AM by BIGAL »

#### ronjonp

• Needs a day job
• Posts: 7186
##### Re: How to start this lisp to sum numbers in each row?
« Reply #6 on: June 19, 2019, 09:31:15 AM »
See if this turns on any light bulbs for the sorting .. I commented each line so you can learn from it.
Code - Auto/Visual Lisp: [Select]
1. (defun c:foo (/ _dxf a b c e h n p s x)
2.   ;; RJP » 2019-06-19
3.   ;; Subroutine for (cdr (assoc 'code'
4.   (defun _dxf (c e) (cdr (assoc c (entget e))))
5.   (cond
6.       ;; Get text
7.     ((and (setq s (ssget '((0 . "text")))) (setq b (getpoint "\nPick a point for result column: ")))
8.      ;; Convert to list of enames
9.      (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
10.      ;; While we have at least one item in the list
11.      (while (setq e (car s))
12.        ;; Insertion point of text
13.        (setq p (_dxf 10 e))
14.        ;; Height ( used for fuzz value )
15.        (setq h (_dxf 40 e))
16.        ;; Remove text that does not 'equal' the Y value of 'p' above
17.        (setq a (vl-remove-if-not '(lambda (x) (equal (cadr (_dxf 10 x)) (cadr p) h)) s))
18.        ;; Convert the text values to numbers and sum them (atof "F1") returns 0.
19.        (setq n (apply '+ (mapcar '(lambda (x) (atof (_dxf 1 x))) a)))
20.        ;; Remove the items from the list 's' so we don't get stuck in a loop
21.        (setq s (vl-remove-if '(lambda (x) (member x a)) s))
22.        ;; Create new text to place results
23.        (and (setq c (entmake (entget e)))
24.             ;; Update insertion point and total
25.             (entmod (append c (list (list 10 (car b) (cadr p)) (cons 1 (vl-princ-to-string n)))))
26.        )
27.      )
28.     )
29.   )
30.   ;; ssshhhhh
31.   (princ)
32. )
« Last Edit: June 20, 2019, 09:29:39 AM by ronjonp »

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

#### BIGAL

• Swamp Rat
• Posts: 538
• 30 + years of using Autocad
##### Re: How to start this lisp to sum numbers in each row?
« Reply #7 on: June 19, 2019, 09:50:48 PM »
Nice one Ronjonp. Should have remembered atof and strings.

#### Grrr1337

• Swamp Rat
• Posts: 740
##### Re: How to start this lisp to sum numbers in each row?
« Reply #8 on: June 20, 2019, 11:41:52 AM »
A bit of sloppy coding, but whatever -

Code - Auto/Visual Lisp: [Select]
1. ; Related thread (SS->SortedMatrixL) :
3.
4. ; Sum Numbers in Exploded Table
5. ; http://www.theswamp.org/index.php?topic=55258.0
6. (defun C:test ( / mapncar mysort LM:UniqueFuzz SS->SortedMatrixL  M-Text )
7.   ; Map to the nth level items - Lee Mac :
8.   (defun mapncar ( n f l ) (if (< 0 n) (mapcar '(lambda ( x ) (mapncar (1- n) f x)) l) (mapcar f l) ) )
9.
10.   ; (mysort (lambda (a b) (apply '< (mapcar 'car (list a b)))) pL)
11.   (defun mysort ( f L ) (mapcar (function (lambda (x) (nth x L))) (vl-sort-i L (function f))) )
12.
13.   ;; Unique with Fuzz  -  Lee Mac
14.   ;; Returns a list with all elements considered duplicate to a given tolerance removed.
15.   (defun LM:UniqueFuzz ( l f / x r )
16.     (while l (setq x (car l) l (vl-remove-if (function (lambda ( y ) (equal x y f))) (cdr l)) r (cons x r) ) ) (reverse r)
17.   )
18.
19.   ; 1. Prompt for a selection
20.   ; 2. Create Assoc List of (InsertionPoint Vla-Object)
21.   ; 3. Redefine the Assoc List - by grouping the items by X (each group is sorted by Y)
22.   ; 4. Sort the Whole Assoc List by X
23.   ; 5. Obtain the vla-objects from the assoc list
24.   (setq SS->SortedMatrixL
25.     (lambda ( fuzz / SS i o L tmpL rtn )
26.       (cond
27.         ( (and (princ "\nSelect Text-Cells from Exploded Table: ") (setq SS (ssget "_:L-I" '((0 . "*TEXT")))))
28.           (repeat (setq i (sslength SS))
29.             (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i)))))
30.             (setq L (cons (list (vlax-get o 'InsertionPoint) o) L))
31.           ); repeat
32.           (foreach x (LM:UniqueFuzz (mapcar 'caar L) fuzz)
33.             (and
34.               (setq tmpL (vl-remove-if-not (function (lambda (q) (equal x (caar q) fuzz))) L))
35.               (setq tmpL (mysort (lambda (a b) (apply '< (mapcar 'cadr (mapcar 'car (list a b))))) tmpL))
36.               (setq rtn (cons tmpL rtn))
37.             ); and
38.           ); foreach
39.           (and rtn ; rtn - List Of Lists of (InsertionPoint Vla-Object)
40.             (setq rtn (vl-sort rtn (function (lambda (a b) (> (caaar a) (caaar b)))))) ; Resort the Return (whole) List by X's ; ??? Sorting direction
41.             (setq rtn (mapncar 1 '(lambda (x) (cadr x)) rtn)) ; Obtain only the objects ; ???
42.           ); and
43.           rtn ; Result should be Assoc list of vla-objects, where each item defines a row, i.e.: '((o1 o2 o3) (o4 o5 o6) (o7 o8 o9))
44.         ); SS
45.       ); cond
46.     ); lambda
47.   ); setq SS->SortedMatrixL
48.
49.
50.   (defun M-Text (p s h)
51.     (entmakex (append  '((000 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText")) (list (cons 40 h) (cons 10 p) (cons 1 s))))
52.   )
53.
54.
55.   ( ; Main
56.     (lambda ( / L i r mt p pts )
57.       (and
58.         (setq L (reverse (mapcar 'reverse (SS->SortedMatrixL 0.1))))
59.         (setq r
60.           (mapcar ''((x)(apply '+ x))
61.             (mapncar 1 ''((x) (atoi (vlax-get x 'TextString)))
62.                 (cons 'list
63.                   L
64.                 )
65.               )
66.             )
67.           )
68.         )
69.         (setq i -1)
70.         (foreach subL
71.           (mapncar 1 ''((x) (list (vlax-get x 'InsertionPoint)(vlax-get x 'Height)(vlax-get x 'AttachmentPoint)))
72.               (cons 'list
73.                 (mapcar ''((x) (nth (+ (length L) x) L)) '(-2 -1))
74.               )
75.             )
76.           ); mapncar
77.           (setq pts (mapcar 'car subL))
78.           (setq mt
79.             (vlax-ename->vla-object
80.               (M-Text
81.                 (setq p (polar (cadr pts) 0 (apply 'distance pts)))
82.                 (itoa (nth (setq i (1+ i)) r))
84.               )
85.             )
86.           )
88.           (vlax-invoke mt 'Move (vlax-get mt 'InsertionPoint) p)
89.         ); foreach
90.       ); and
91.     ); lambda
92.   )
93.   (princ)
94. ); defun

(apply ''((a b c)(a b c))
'(
(( f L ) (apply 'strcat (f L)))
(( L ) (if L (cons (chr (car L)) (f (cdr L)))))
(72 101 108 108 111 32 87 111 114 108 100)
)
)

• Swamp Rat
• Posts: 1337
##### Re: How to start this lisp to sum numbers in each row?
« Reply #9 on: June 23, 2019, 03:46:01 AM »
You can sort lists multi level deep not just x y, and  you could sort rows that have 1 2 10 texts. It would have ((x y text) (x y text)…….

This is not finished but close, hansacad not sure how you want to do the answers.

The answer to be inserted next to each the raw

• Swamp Rat
• Posts: 1337
##### Re: How to start this lisp to sum numbers in each row?
« Reply #10 on: June 23, 2019, 04:20:03 AM »
See if this turns on any light bulbs for the sorting .. I commented each line so you can learn from it.

Thanks ronjnp
But inserted result text comes in wrong place

• Swamp Rat
• Posts: 1337
##### Re: How to start this lisp to sum numbers in each row?
« Reply #11 on: June 23, 2019, 04:21:50 AM »
A bit of sloppy coding, but whatever -

Thanks Grrr1337

But gives error
Quote
Error: ActiveX Server returned the error: unknown name: "ATTACHMENTPOINT"

#### Lee Mac

• Seagull
• Posts: 12397
• London, England
##### Re: How to start this lisp to sum numbers in each row?
« Reply #12 on: June 23, 2019, 06:42:18 AM »
See if this turns on any light bulbs for the sorting .. I commented each line so you can learn from it.

Thanks ronjnp
But inserted result text comes in wrong place

Ron's method looks sound - I can only think that UCS is perhaps playing a part.

#### ronjonp

• Needs a day job
• Posts: 7186
##### Re: How to start this lisp to sum numbers in each row?
« Reply #13 on: June 24, 2019, 10:27:57 AM »
See if this turns on any light bulbs for the sorting .. I commented each line so you can learn from it.

Thanks ronjnp
But inserted result text comes in wrong place
Post the drawing you are testing on. Like Lee suggested it's probably a UCS issue.

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC