Jump to content

I have to sum value in different formats.

sanju2323

By sanju2323
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

sanju2323 Collaborator

sanju2323

Posted
Posted

Hello Everyone,

I have to sum value in different formats. ex.  00-01-00

                                                                         +    00-01-00

                                                                               ---------------

                                                                Total      00-02-00

 

 

Thank you in advance

 

Sum Value.dwg

BIGAL Grand Master

BIGAL

Posted
Posted

What you can do is parse the string so break it into 3 bits make a list ("00" "01" " 00") then sum like a column, (nth 0 (nth 1 (nth 2. Lee-mac has a parse.lsp normally used for csv files but yiu can change the delimeter to "-"

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Try out this, be a little bit careful when picking text.

  

; totals a multi string with delimeter like a csv
; by Alan H July 2019
; ascii 45 is -

; thanks to Lee-mac for this defun
(defun _csv->lst ( str / pos )
(if (setq pos (vl-string-position 45 str))
    (cons (substr str 1 pos) (_csv->lst (substr str (+ pos 2))))
    (list str)
    )
)

(defun c:sumcoltext ( / x ss txt obj lst tent ans)
(setq lst '())
(setq ss (ssget (list (cons 0 "Text"))))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object(ssname ss (setq x (- x 1)))))
(setq txt (vla-get-textstring obj))
(setq lst (cons (_csv->lst txt) lst))
)

(setq tot1 0 tot2 0 tot3 0)
(repeat (setq x (length lst))
(setq row (nth (setq x (- x 1)) lst))
(setq tot1 (+ tot1 (atof (nth 0 row))))
(setq tot2 (+ tot2 (atof (nth 1 row))))
(setq tot3 (+ tot3 (atof (nth 2 row))))
)

(setq ans (strcat (rtos tot1 2 0) "-" (rtos tot2 2 0) "-" (rtos tot3 2 0)))
(vla-put-textstring (vlax-ename->vla-object (car (entsel "pick text"))) ans)

(princ)

)

(c:sumcoltext)

 

 

Edited by BIGAL
Roy_043 Mentor

Roy_043

Posted
Posted (edited)

Try: 

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

; First string in lst defines the format and also the length of the return value.
(defun SumTxt (lst / format i j ret tot)
  (setq tot
    (reverse
      (vl-string->list
        (itoa
          (apply
            '+
            (mapcar
              '(lambda (str)
                (atoi
                  (vl-list->string
                    (vl-remove-if-not
                      '(lambda (int) (<= 48 int 57)) ; "0"-"9": 48-57.
                      (vl-string->list str)
                    )
                  )
                )
              )
              lst
            )
          )
        )
      )
    )
  )
  (setq format (reverse (vl-string->list (car lst))))
  (setq i 0)
  (setq j 0)
  (repeat (length format)
    (cond
      ((not (<= 48 (nth (+ i j) format) 57))
        (setq ret (cons (nth (+ i j) format) ret))
        (setq j (1+ j))
      )
      ((nth i tot)
        (setq ret (cons (nth i tot) ret))
        (setq i (1+ i))
      )
      (T
        (setq ret (cons 48 ret))
        (setq i (1+ i))
      )
    )
  )
  (vl-list->string ret)
)

(defun c:SumTxt ( / enm ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (princ "\nSelect texts to sum up: ")
      (setq ss (ssget '((0 . "TEXT"))))
      (setq enm (car (entsel "Select target text: ")))
      (setq obj (vlax-ename->vla-object enm))
      (= "AcDbText" (vla-get-objectname obj))
    )
    (vla-put-textstring
      obj
      (SumTxt
        (mapcar 'vla-get-textstring (KGA_Conv_Pickset_To_ObjectList ss))
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

Edited by Roy_043
sanju2323 Collaborator

sanju2323

Posted
  • Author
Posted
1 hour ago, Roy_043 said:

Try:

 

    Thank you both for answering, I am sorry that I was a little unable to explain, but Roy_043 Lisp works correctly.

Thank you ones again 


(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

; First string in lst defines the format and also the length of the return value.
(defun SumTxt (lst / format i j ret tot)
  (setq tot
    (reverse
      (vl-string->list
        (itoa
          (apply
            '+
            (mapcar
              '(lambda (str)
                (atoi
                  (vl-list->string
                    (vl-remove-if-not
                      '(lambda (int) (<= 48 int 57)) ; "0"-"9": 48-57.
                      (vl-string->list str)
                    )
                  )
                )
              )
              lst
            )
          )
        )
      )
    )
  )
  (setq format (reverse (vl-string->list (car lst))))
  (setq i 0)
  (setq j 0)
  (repeat (length format)
    (cond
      ((not (<= 48 (nth (+ i j) format) 57))
        (setq ret (cons (nth (+ i j) format) ret))
        (setq j (1+ j))
      )
      ((nth i tot)
        (setq ret (cons (nth i tot) ret))
        (setq i (1+ i))
      )
      (T
        (setq ret (cons 48 ret))
        (setq i (1+ i))
      )
    )
  )
  (vl-list->string ret)
)

(defun c:SumTxt ( / enm ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (princ "\nSelect texts to sum up: ")
      (setq ss (ssget '((0 . "TEXT"))))
      (setq enm (car (entsel "Select target text: ")))
      (setq obj (vlax-ename->vla-object enm))
      (= "AcDbText" (vla-get-objectname obj))
    )
    (vla-put-textstring
      obj
      (SumTxt
        (mapcar 'vla-get-textstring (KGA_Conv_Pickset_To_ObjectList ss))
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

 

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Nice idea looking for non number added to code above any character but still 3 columns.

Edited by BIGAL
sanju2323 Collaborator

sanju2323

Posted
  • Author
Posted (edited)

Bigal is right. It shows the value of only in three character, I've attached another test2 drawing and you can understand d it better.

Thank you Bigal

Test2.dwg

Edited by sanju2323
missing attachment
rlx Grand Master

rlx

Posted
Posted

I made this one yesterday but never posted it because Bigal had beaten me to it and cant beat Roy's elegant code either but untested on your last example , here it is anyway...

  


; (SplitStr "01-02-03" "-") -> ("01" "02" "03")
(defun SplitStr ( s d / p )
  (if (setq p (vl-string-search d s))(cons (substr s 1 p) (SplitStr (substr s (+ p 1 (strlen d))) d)) (list s)))

(defun SS->EL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)

(defun c:t1 ( / p1 p2 ss sel e txt-list sum l) (vl-load-com)
  (while
    (and
      (setq p1 (getpoint "\nFirst corner to select text entities to sum : "))
      (setq p2 (getcorner p1 "\nSecond corner : "))
      (setq ss (ssget "C" p1 p2 (list (cons 0 "TEXT"))))
     
      (setq sel (entsel "\nSelect text entity for result"))
      (= (cdr (assoc 0 (entget (setq e (car sel))))) "TEXT")
    )
    (setq txt-list (mapcar '(lambda (x) (apply 'strcat (SplitStr (cdr (assoc 1 (entget x))) "-"))) (SS->EL ss)))
    (setq sum (itoa (apply '+ (mapcar 'atoi txt-list))))
    (while (< (strlen sum) 6)(setq sum (strcat "0" sum)))
    (setq l (strlen sum))
    (vla-put-textstring (vlax-ename->vla-object e)
      (strcat (substr sum 1 (- l 4)) "-" (substr sum (- l 3) 2) "-" (substr sum (1- l))))
  )        
  (princ)
)
; auto start upon loading
(c:t1)

 

Roy_043 Mentor

Roy_043

Posted
Posted

Revised code: 

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

; First string in lst defines the format.
(defun SumTxt (lst / format i j ret tot)
  (setq tot
    (reverse
      (vl-string->list
        (itoa
          (apply
            '+
            (mapcar
              '(lambda (str)
                (atoi
                  (vl-list->string
                    (vl-remove-if-not
                      '(lambda (int) (<= 48 int 57)) ; "0"-"9": 48-57.
                      (vl-string->list str)
                    )
                  )
                )
              )
              lst
            )
          )
        )
      )
    )
  )
  (setq format (reverse (vl-string->list (car lst))))
  (setq i 0)
  (setq j 0)
  (repeat
    (max
      (length format)
      (+
        (length tot)
        (length
          (vl-remove-if
            '(lambda (int) (<= 48 int 57))
            format
          )
        )
      )
    )
    (cond
      (
        (and
          (nth (+ i j) format)
          (not (<= 48 (nth (+ i j) format) 57))
        )
        (setq ret (cons (nth (+ i j) format) ret))
        (setq j (1+ j))
      )
      ((nth i tot)
        (setq ret (cons (nth i tot) ret))
        (setq i (1+ i))
      )
      (T
        (setq ret (cons 48 ret))
        (setq i (1+ i))
      )
    )
  )
  (vl-list->string ret)
)

(defun c:SumTxt ( / enm ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (princ "\nSelect texts to sum up: ")
      (setq ss (ssget '((0 . "TEXT"))))
      (setq enm (car (entsel "Select target text: ")))
      (setq obj (vlax-ename->vla-object enm))
      (= "AcDbText" (vla-get-objectname obj))
    )
    (vla-put-textstring
      obj
      (SumTxt
        (mapcar 'vla-get-textstring (KGA_Conv_Pickset_To_ObjectList ss))
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

sanju2323 Collaborator

sanju2323

Posted
  • Author
Posted (edited)

Rlx,

    Thank you so much for the code

     This code is work fine, but there is a small problem in this code. It only sum the object appearing in the screen.

Edited by sanju2323
rlx Grand Master

rlx

Posted
Posted
11 minutes ago, sanju2323 said:

Rlx,

    Thank you so much for the code

     This code is work fine, but there is a small problem in this code. It only sum the object appearing in the screen.

 

if by this you mean you have to make a selection for each column of texts you are right because if you want to be able to do the entire drawing with one click this would be a complete other ballgame ...

sanju2323 Collaborator

sanju2323

Posted
  • Author
Posted

Rlx,

  Please see the attached gif file.

Rlx.gif

sanju2323 Collaborator

sanju2323

Posted
  • Author
Posted

Roy_043,

            Thank you so much your code perfectly work i am so happy. :) 

rlx Grand Master

rlx

Posted
Posted (edited)

ah I see what you mean and I know the 'problem' , when I was making the code I was thinkin', oh , don't forget to reset the text-list each loop... but that's when Bigal posted his code and I thought , oh darn ... no use to go on... And since Roy's elegant code is working no use for me to update anymore. Nice code Roy!

 

ps routine is fine , your way of selecting isn't , you are selecting things double because of osnap.

Edited by rlx
sanju2323 Collaborator

sanju2323

Posted
  • Author
Posted

rlx,

 

I did not know that this would be possible, but all of you contributed a bit, your code was great for the loop, but the Roy_043 code gives the exact answer, rather gave me a much better code than i expected, Thank you all for giving your precious time and participating in this forum.

BIGAL Grand Master

BIGAL

Posted
Posted

Its the sort of challenge that is interesting looks simple then comes request 2. hence why we all had a go. 

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...