need lisp for sum text number after a specific alphabet character

[sakrado]

hi everyone

i have file dwg that need to sum the number after letter

FD 12.3

FD 13.4

FD 14

BOX 125

BOX 12

FD 23.8 EBA 25.4

LU 12.4 FD 23.7

DU 45 FD 12

etc...

 

I want to get result

FD=....

EBA=...

LU=...

DU=...

BOX=...

 

i need lisp code to sum its

AND I WANT TO LISP CODE CAN TO APPLY ALL DRAWING FILE

Because it's hard to calculate by calculator:(

Anyone can help me ???

[BIGAL]

A couple of questions what is FD 12.3 is it text mtext or a block attribute ?

 

An answer have you tried dataextract then you import the CSV which splits the text based on the space into excel you can do a excel macro to check text value and add up like text values.

 

The last option a lisp is make a list of text, sort it then use say Lee-Mac parse text to pull numeric out then add up checking to see if text has changed. probably making a new list of answers.

 

Last question how do you want to output results just display F2 ?

[sakrado]

they are texts/mtexts. not block attribute

and i need lisp to sum only number after FD , EBA,...etc

to get result:

FD=???

EBA=???

etc...

I have my lsp code but it apply only one drawing file. can u develop it more.

(defun C:GPS(/ all dirty en i ip item lb p1 p2 ss st string->list summary tmp uniques x) ;; helper ;; by Tony Tanzillo (defun string->list (s delim) (read (vl-list->string (append '(40 34) ;; add '("' to start (apply 'append (subst '(34 34) (vl-string->list delim) (mapcar 'list (vl-string->list s)) ) ) '(34 41) ;; add '")" to end ) ) ) ) ;; main part ;; (princ "\Select table text by window selection") (setq p1 (getpoint "\nSpecify the first corner point: >> ") p2 (getcorner p1 "\nSpecify the opposite corner point: >> ") ) (setq ss (ssget "W" (list (car p1)(cadr p1)) (list (car p2)(cadr p2)) (list (cons 0 "*TEXT"))) i -1 ) (repeat (sslength ss) (setq en (ssname ss (setq i (1+ i))) ip (cdr (assoc 10 (entget en))) st (cdr (assoc 1 (entget en))) st (substr st (+ 2 (vl-string-position (ascii";") st ))(vl-string-position (ascii";") st )) tmp (mapcar '(lambda (x)(if (zerop (atoi x)) x (atoi x))) (string->list st " "))) (while (cadr tmp) (setq item (cons (car tmp)(cadr tmp))) (setq dirty (cons item dirty)) (setq tmp (cddr tmp)))) (setq all (mapcar 'car dirty) uniques nil) (while (car all) (setq uniques (cons (car all) uniques)) (setq all (vl-remove-if '(lambda (x)( eq x(car all)))all)) ) (setq i -1 tmp nil) (repeat (length uniques) (setq tmp (cons (setq lb (nth (setq i (1+ i)) uniques)) (apply '+ (mapcar 'cdr (vl-remove-if-not '(lambda (x)(eq (car x) lb)) dirty))))) (setq summary (cons tmp summary))) (setq summary (vl-sort summary '(lambda (a b) (

[fixo]

Here is extended version I've post you before,

would work with text and mtext, to process many drawing

create script and load this lisp in the every drawing,

search forum for batch drawings or use ScriptPro

I need to see your real text to read and summarize their valuess after,

otherwise it is impossible to understand what you want

 
(defun C:GPS(/ all dirty en _group_and_sum i ip item lb p1 p2 ss st string->list summary tmp TTC_MText_Clear uniques x)
 ;; helpers

 ;; by Tony Tanzillo  ;;
(defun string->list (s delim)
  (read
     (vl-list->string
        (append
          '(40 34)        ;; add '("' to start
           (apply 'append
              (subst 
                '(34 34) 
                 (vl-string->list delim)
                 (mapcar 'list (vl-string->list s))
              )
           )
          '(34 41)       ;; add '")" to end
        )
     )
  )
)

    ;; Cleat MTEXT formatting  ;;
    ;; by VVA   ;;
   (defun TTC_MText_Clear(Mtext / Text Str) 
   (setq Text "") 
   (while(/= Mtext "") 
     (cond 
 ((wcmatch 
    (strcase 
      (setq Str 
       (substr Mtext 1 2))) 
                    "[url="file://[//"]\\[\\[/url]{}`~]") 
  (setq Mtext(substr Mtext 3) 
        Text(strcat Text Str) 
  ); end setq 
 ); end condition #1 
 ((wcmatch(substr Mtext 1 1) "[{}]") 
   (setq Mtext 
    (substr Mtext 2)) 
 ); end condition #2 
 ( 
  (and 
  (wcmatch 
    (strcase 
      (substr Mtext 1 2)) "[url="file://p/"]\\P[/url]") 
  (/=(substr Mtext 3 1) " ") 
   ); end and 
        (setq Mtext (substr Mtext 3) 
              Text (strcat Text " ") 
        ); end setq 
  ); end condition #3 
 ((wcmatch 
    (strcase 
      (substr Mtext 1 2)) "[url="file://[lop/"]\\[LOP[/url]]") 
   (setq Mtext(substr Mtext 3)) 
 ); end condition #4 
 ((wcmatch 
    (strcase 
      (substr Mtext 1 2)) "[url="file://[acfhqtw/"]\\[ACFHQTW[/url]]") 
   (setq Mtext 
    (substr Mtext 
      (+ 2 
         (vl-string-search ";" Mtext)))) 
 ); end condition #5 
 ((wcmatch 
    (strcase (substr Mtext 1 2)) "[url="file://s/"]\\S[/url]") 
   (setq Str(substr Mtext 3 (- (vl-string-search ";" Mtext) 2)) 
         Text(strcat Text (vl-string-translate "#^\\" " " Str)) 
         Mtext(substr Mtext (+ 4 (strlen Str))) 
  ); end setq 
  (print Str) 
 ); end condition #6 
 (T 
  (setq Text(strcat Text(substr Mtext 1 1)) 
        Mtext (substr Mtext 2) 
  ) 
 ); end condition #7 
     ); end cond 
   ); end while 
 Text 
); end of TTC_MText_Clear

;; fixo () 2010 * all rights released      ;;
;; arguments: lst - list of pairs kind of:   
;;(setq lst '(("a" . 12)("b" . 12)("a" . 26) ("d" . 23)("b" . 20)("a" . 24) ("c" . 12)("d" . 27)))..etc...;;
(defun _group_and_sum (lst / all i lb summary tmp uniques)
 (setq all (mapcar 'car lst)
uniques nil
 ) ;_ end of setq
 (while (car all)
   (setq uniques (cons (car all) uniques))
   (setq all (vl-remove-if '(lambda (x) (eq x (car all))) all))
 ) ;_ end of while
 (setq i   -1
tmp nil
 ) ;_ end of setq
 (repeat (length uniques)
   (setq tmp
   (cons
     (setq lb (nth (setq i (1+ i)) uniques))
     (apply '+
     (mapcar
       'cdr
       (vl-remove-if-not '(lambda (x) (eq (car x) lb)) lst)
     ) ;_ end of mapcar
     ) ;_ end of apply
   ) ;_ end of cons
   ) ;_ end of setq
   (setq summary (cons tmp summary))
 ) ;_ end of repeat
 (vl-sort summary '(lambda (a b) (< (car a) (car b))))
) ;_ end of defun
;;    Usage _group_and_sum lst) ;;

;;    main part    ;;

 (princ "\Select table text by window selection")
 (setq p1 (getpoint "\nSpecify the first corner point: >> ")
p2 (getcorner p1 "\nSpecify the opposite corner point: >> ")
)
 (setq ss (ssget "W" (list (car p1)(cadr p1)) (list (car p2)(cadr p2)) (list (cons 0 "*TEXT")))
i  -1
 )
 (repeat (sslength ss)
   (setq en   (ssname ss (setq i (1+ i)))
  ip   (cdr (assoc 10 (entget en)))
  st  (cdr (assoc 1 (entget en))))
  ;st (substr st (+ 2 (vl-string-position (ascii";") st ))(vl-string-position (ascii";") st ))
  (if (eq "MTEXT" (cdr (assoc 0 (entget en))))(setq  st (TTC_MText_Clear st)))
   (setq tmp (mapcar '(lambda (x)(if (zerop (atof x)) x (atof x))) (string->list st " ")))
(while (cadr tmp)
 (setq item (cons (car tmp)(cadr tmp)))
 (setq dirty (cons item dirty))
 (setq tmp (cddr tmp))))
(setq summary    (_group_and_sum dirty))
 (print summary)
 (textscr); display result

;;   --- do whatever you want with 'summary' here ---  ;;

(princ)
 )
(prompt "\n\t*** Type GPS to execute...")
(prin1)

Edited April 1, 2013 by fixo
note added

[pBe]

Another:

 

It would be loads easier if you identify the target prefix on the ssget filter from the get-go i.e. (1 . "FD #*,EBA #*,LU #*,DU #*,BOX #*"), thus eliminating the need to select on screen.

 

(defun c:demo	(/ numbr strs data ss a b num )(vl-load-com)
 (setq	numbr (lambda (s sw)
	(distof (substr s (1+ (strlen sw))))
      )
 )
 (if (setq strs nil
    data nil
    ss	 (ssget "_x" '((0 . "*Text")(1 . "FD #*,EBA #*,LU #*,DU #*,BOX #*")))
     )
   (progn
     (repeat (setq i (sslength ss))
(setq strs (cons
	     (Cdr (assoc 1 (entget (ssname ss (setq i (1- i))))))
	     strs
	   )
)
     )
     (setq strs (acad_strlsort strs))
     (while (setq a (Car strs))
(setq strs (cdr strs)
      b	   (vl-string-right-trim ".0123456789" a)
      num  (list (numbr a b))
)
(if (/= a b)
  (progn
	(vl-some '(lambda (x)
		    (if	(wcmatch x (strcat b "*"))
		      (progn
			(setq num (cons (numbr x b) num))
			(setq strs (Cdr strs))
			nil
		      )
		    )
		  )
		 strs
	)
	(setq data (cons (Cons b (list num)) data))
     	)
  )
)
     (foreach itm (reverse data)
	(print (strcat (car itm) "= " (rtos (apply '+ (cadr itm)) 2 3))))
   )
 )(princ)
)

 

>

 

HTH

[sakrado]

Wow it is working . And can apply to every drawing

thank you very much again...

[sakrado]

HI ! FIXO i am very thank you TO YOU. but your lisp code can not sum include decimal digit behind.

FOR EXAMPLE

FD 12.2 + FD 12.5 IT SHOULD BE EQUAL (FD 24.7)

BUT YOUR LISP CODE ROUND IT DOWN TO ZERO

LIKE THIS:

(FD 24)

CAN YOU DEVELOP YOUR LISP CODE MORE?

[fixo]

HI ! FIXO i am very thank you TO YOU. but your lisp code can not sum include decimal digit behind.

FOR EXAMPLE

FD 12.2 + FD 12.5 IT SHOULD BE EQUAL (FD 24.7)

BUT YOUR LISP CODE ROUND IT DOWN TO ZERO

LIKE THIS:

(FD 24)

CAN YOU DEVELOP YOUR LISP CODE MORE?

 

Are you sure?

I edited lisp yesterday, copy / paste again

[sakrado]

OK. BUT I WANT TO SELECT IT BY OBJECT (FIRST OR LAST) ENTER COMMAND .NOT BY WINDOW SELECTION

(princ "\Select table text by window selection")
 (setq p1 (getpoint "\nSpecify the first corner point: >> ")
p2 (getcorner p1 "\nSpecify the opposite corner point: >> ")

 

 

COULD YOU DEVELOP IT MORE ?

[SLW210]

sakrado,

 

Please read the CODE POSTING GUIDELINES and edit your Code to use Code Tags.