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

0 Members and 1 Guest are viewing this topic.

HasanCAD

  • Swamp Rat
  • Posts: 1306
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: 12270
  • 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?

HasanCAD

  • Swamp Rat
  • Posts: 1306
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: 12270
  • 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.

HasanCAD

  • Swamp Rat
  • Posts: 1306
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)))
  17.       (if (numberp (read entS))
  18.         (progn
  19.           (setq entPS (list entP entS))
  20.           (setq entsPS (cons entPS entsPS))
  21.  
  22.           (setq entL (cdr (assoc 08 ent)))
  23.           (setq entH (cdr (assoc 40 ent)))
  24.  
  25.           (setq entP (cdr (assoc 10 ent)))
  26.           (setq entPX (nth 0 entP))
  27.           (setq entPY (nth 1 entP))  
  28.  
  29.           (SETQ entSm (atoi sum))
  30.           (setq sumP (list (+ entPX (* 3 entH))  entPY))
  31.           (MakeText entSm sumP entL entH 0 0 1 )
  32.           )
  33.         )
  34.       )
  35.     )
  36.   (PRINC)
  37.   )
  38.  
  39. (defun MakeText (str pt lyr ht ro G72 G73)
  40.   (entmakex (list (cons 0 "TEXT")       ;***
  41.                  (cons 1 str)           ;* (the string itself)
  42.                  (cons 6 "BYLAYER")     ; Linetype name
  43.                  (cons 8 lyr)           ; layer
  44.                  (cons 10 pt)           ;* First alignment point (in OCS)
  45.                  (cons 11 pt)           ;* Second alignment point (in OCS)
  46.                  (cons 39 0.0)          ; Thickness (optional; default = 0)
  47.                  (cons 40 ht)           ;* Text height
  48.                  (cons 41 1.0)          ; Relative X scale factor, Width Factor, defaults to 1.0
  49.                  (cons 50 ro)           ; Text rotation angle
  50.                  (cons 51 0.0)          ; Oblique angle
  51.                  (cons 62 256)          ; color
  52.                  (cons 71 0)            ; Text generation flags
  53.                  (cons 72 G72)          ; Horizontal text justification type
  54.                  (cons 73 G73)          ; Vertical text justification type
  55.                  (cons 210 (list 0.0 0.0 1.0)))))
  56.  
  57. (defun *error* ( msg )
  58.   (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")))
  59.     (princ (strcat "\nError: " msg))
  60.     )
  61.   (princ)
  62.   )
  63.  

BIGAL

  • Bull Frog
  • Posts: 320
  • 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 »
A man who never made a mistake never made anything

ronjonp

  • Needs a day job
  • Posts: 7028
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

  • Bull Frog
  • Posts: 320
  • 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.
A man who never made a mistake never made anything

Grrr1337

  • Swamp Rat
  • Posts: 696
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) :
  2. ; https://www.cadtutor.net/forum/topic/63343-switching-two-items-in-a-table-in-autocad-lisp/?tab=comments#comment-522608
  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.               (apply 'mapcar
  63.                 (cons 'list
  64.                   L
  65.                 )
  66.               )
  67.             )
  68.           )
  69.         )
  70.         (setq i -1)
  71.         (foreach subL
  72.           (mapncar 1 ''((x) (list (vlax-get x 'InsertionPoint)(vlax-get x 'Height)(vlax-get x 'AttachmentPoint)))
  73.             (apply 'mapcar
  74.               (cons 'list
  75.                 (mapcar ''((x) (nth (+ (length L) x) L)) '(-2 -1))
  76.               )
  77.             )
  78.           ); mapncar
  79.           (setq pts (mapcar 'car subL))
  80.           (setq mt
  81.             (vlax-ename->vla-object
  82.               (M-Text
  83.                 (setq p (polar (cadr pts) 0 (apply 'distance pts)))
  84.                 (itoa (nth (setq i (1+ i)) r))
  85.                 (cadr (mapcar 'cadr subL))
  86.               )
  87.             )
  88.           )
  89.           (vlax-put mt 'AttachmentPoint (cadr (mapcar 'caddr subL)))
  90.           (vlax-invoke mt 'Move (vlax-get mt 'InsertionPoint) p)
  91.         ); foreach
  92.       ); and
  93.     ); lambda
  94.   )
  95.   (princ)
  96. ); 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)
  )
)

HasanCAD

  • Swamp Rat
  • Posts: 1306
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

HasanCAD

  • Swamp Rat
  • Posts: 1306
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

HasanCAD

  • Swamp Rat
  • Posts: 1306
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: 12270
  • 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: 7028
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