Topic: Add-Subtract Routine for Architectural/fractions

[CAB]

Thanks, here is a quick fix.
I will clean up the routine tomorrow.

[Biscuits]

Thank you, your Lispness!

I bow before your mighty parenthesisesence!

Very intense routine and works great for my needs.


However, it would not change a whole number though.

[CAB]

Thanks for your kind words.

When I fix one issue another crops up, but this version seems to be close.
Still have some issues but please report any you find.

[Biscuits]

At this stage of the routine:

Enter increment value: <1>1 1/2

I get this error:

Error: bad argument type: numberp: nilundo Current settings: Auto = On, Control
= All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: end

[CAB]

Well hang with me a little longer. I'll get this one nailed down yet.
Now you see why I was dragging my feet in adding support for fractions.

[Biscuits]

Hey Cab

You been working so hard on this.......I'm giving you the weekend off.

In the mean time, I get to shovel snow

[M-dub]

So many fractions!!! 

Wouldn't this be easier if we were all in metric?! 

[MP]

united we stand, divided we fall!!

oh wait, wrong thread

[CAB]

Metric is the way to go but I fear fractions will be with us for quite some time.

[M-dub]

Metric is the way to go but I fear fractions will be with us for quite some time.

Couldn't agree more.

[T.Willey]

See if this works for you.  Seems to work on the two test strings here.  Will update all numbers found within the string.

Code: [Select]

(defun ParseStringDigit (String / cnt tempStr EndList LenStr cStr bIsDigit)
   
    (setq LenStr (strlen String))
    (setq cnt 2)
    (setq tempStr (substr String 1 1))
    (if (<= 48 (ascii tempStr) 57)
        (setq bIsDigit T)
    )
    (while (<= cnt LenStr)
        (setq cStr (substr String cnt 1))
        (setq cAscii (ascii cStr))
        (if bIsDigit
            (if
                (or
                    (<= 45 cAscii 57)
                    (equal cAscii 39)
                    (and
                        (equal cAscii 32)
                        (<= 45 (ascii (substr String (1+ cnt) 1)) 57)
                        (vl-string-search "/" String cnt)
                        (or
                            (not (vl-string-search " " String (+ 2 cnt)))
                            (<
                                (vl-string-search "/" String cnt)
                                (vl-string-search " " String (+ 2 cnt))
                            )
                        )
                    )
                )
                (setq tempStr (strcat tempStr cStr))
                (progn
                    (setq EndList
                        (cons
                            (if
                                (or
                                    (vl-string-search "." tempStr)
                                    (vl-string-search "/" tempStr)
                                    (vl-string-search "-" tempStr)
                                )
                                (progn
                                    (setq rtosType
                                        (cond
                                            ((vl-string-search "'" tempStr)
                                                4
                                            )
                                            ((vl-string-search "/" tempStr)
                                                3
                                            )
                                            (t 2)
                                        )
                                    )
                                    (list
                                        "Real"
                                        tempStr
                                        rtosType
                                        (if (equal rtosType 2)
                                            (if (setq tempPos (vl-string-search "." tempStr))
                                                (strlen (substr tempStr (+ 2 tempPos)))
                                                0
                                            )
                                            (if (setq tempPos (vl-string-search "/" tempStr))
                                                (WhatExponent (atoi (substr tempStr (+ 2 tempPos))) 2)
                                                0
                                            )
                                        )
                                    ) ;(distof tempStr 4)
                                )
                                (cons "Int" tempStr) ;(atoi tempStr)
                            )
                            EndList
                        )
                    )
                    (setq bIsDigit nil)
                    (setq tempStr cStr)
                )
            )
            (if (<= 48 cAscii 57)
                (progn
                    (setq EndList (cons tempStr EndList))
                    (setq bIsDigit T)
                    (setq tempStr cStr)
                )
                (setq tempStr (strcat tempStr cStr))
            )
        )
        (setq cnt (1+ cnt))
    )
    (reverse
        (cons
            (if (<= 48 cAscii 57)
                (if
                    (or
                        (vl-string-search "." tempStr)
                        (vl-string-search "/" tempStr)
                        (vl-string-search "-" tempStr)
                    )
                    (progn
                        (setq rtosType
                            (cond
                                ((vl-string-search "'" tempStr)
                                    4
                                )
                                ((vl-string-search "/" tempStr)
                                    5
                                )
                                (t 2)
                            )
                        )
                        (list
                            "Real"
                            tempStr
                            rtosType
                            (if (equal rtosType 2)
                                (if (setq tempPos (vl-string-search "." tempStr))
                                    (strlen (substr tempStr (+ 2 tempPos)))
                                    0
                                )
                                (if (setq tempPos (vl-string-search "/" tempStr))
                                    (WhatExponent (atoi (substr tempStr (+ 2 tempPos))) 2)
                                    0
                                )
                            )
                        ) ;(distof tempStr 4)
                    )
                    (cons "Int" tempStr) ;(atoi tempStr)
                )
                tempStr
            )
            EndList
        )
    )
)
(defun AddNumbersTo ( inList inNum )
   
    (mapcar
        '(lambda (x)
            (if (equal (type x) 'LIST)
                (if (= (car x) "Real")
                    (rtos (+ (distof (cadr x) 3) inNum) (caddr x) (cadddr x))
                    (atoi (+ (atoi (cdr x)) inNum))
                )
                x
            )
        )
        inList
    )
)
(defun WhatExponent ( num expNum / cnt tempNum )
   
    (setq cnt 1)
    (setq tempNum expNum)
    (while (not (equal num tempNum))
        (setq tempNum (* tempNum expNum))
        (setq cnt (1+ cnt))
    )
)
(defun c:Test (/ AddNum Sel Obj)
   
    (if
        (and
            (setq AddNum (getstring T "\n Enter number to add: "))
            (setq AddNum (distof AddNum))
            (not (equal AddNum 0))
            (setq Sel (entsel "\n Select entity to add to: "))
            (setq Obj (vlax-ename->vla-object (car Sel)))
        )
        (vla-put-TextString Obj (apply 'strcat (AddNumbersTo (ParseStringDigit (vla-get-TextString Obj)) AddNum)))
    )
    (princ)
)


[CAB]

Haven't tried all these but did get some errors.


abc 3.5..       
abc 3 1/2       
abc 3 1/2"
abc 3 1/2'       
abc 3'-1"
abc 3'-1         
abc 3' 1                   
abc 3' 1"
abc 3' 1 1/2               
abc 3'-1-1/2     
abc 3' 1 1/2"             
abc 3' 1.5                 
abc 3'.5         
abc 3'0.5       
abc 3'-0.5       
abc 3'-0.5"       
abc -10         
abc .5           
abc 0.5         
abc 1/2         
abc 1/2"       
abc 9 1/2       
abc 1.55E+01     
abc 5 A         
00000           
abc             
abc 3' -1

[Biscuits]

Thanks, Tim

It's close.
Here's the test results

in adding 1 1/32

to 14 1/4 = 15 1/4
to 47 29/32 = 48 15/16
to 48 15/16 = 50

[T.Willey]

Alan,

  It does error on ones that ' distof ' doesn't know what to do with.  There are so many combinations that could be wrong, that I don't really know how one could code for all occurances, unless the code is super huge, which I was not trying to do.     I did test most of your list though.  I can go through it again, and have a better type of error handling.

Biscuits,

  The reason why yours didn't work is two fold.  One is that the code looks at the string that is current, and then detimenes what percision is needed.  So when the base number has a lower percision than the one being added to it, it doesn't recognize it.  And the second is the way that acad translates strings->reals and reals->strings.  This is a know issue.  I'm not quite sure how to get around it at the moment.

[T.Willey]

Here we go.  This one seems to be working better.  Let me know.

Alan,

  On your old list, these are the ones it couldn't do.  Not saying that it translated them right, but these are the ones it couldn't do at all.

Command: (foreach i lst (addnumbersto (parsestringdigit i 0) 1.5))(princ)

 Could not translate: 10-1 into a number.
 Could not translate: 10-1 into a number.
 Could not translate: 3'- into a number.
 Could not translate: 10-1 into a number.
 Could not translate: 10-1 into a number.
 Could not translate: 10-1-5 into a number.

Code: [Select]

(defun ParseStringDigit (String basePrec / cnt tempStr EndList LenStr cStr bIsDigit)
   
    (setq LenStr (strlen String))
    (setq cnt 2)
    (setq tempStr (substr String 1 1))
    (if (<= 48 (ascii tempStr) 57)
        (setq bIsDigit T)
    )
    (while (<= cnt LenStr)
        (setq cStr (substr String cnt 1))
        (setq cAscii (ascii cStr))
        (if bIsDigit
            (if
                (or
                    (<= 45 cAscii 57)
                    (equal cAscii 39)
                    (and
                        (equal cAscii 32)
                        (<= 45 (ascii (substr String (1+ cnt) 1)) 57)
                        (vl-string-search "/" String cnt)
                        (or
                            (not (vl-string-search " " String (+ 2 cnt)))
                            (<
                                (vl-string-search "/" String cnt)
                                (vl-string-search " " String (+ 2 cnt))
                            )
                        )
                    )
                )
                (setq tempStr (strcat tempStr cStr))
                (progn
                    (setq EndList
                        (cons
                            (if
                                (or
                                    (vl-string-search "." tempStr)
                                    (vl-string-search "/" tempStr)
                                    (vl-string-search "-" tempStr)
                                    (vl-string-search "'" tempStr)
                                )
                                (progn
                                    (setq rtosType
                                        (cond
                                            ((vl-string-search "'" tempStr)
                                                4
                                            )
                                            ((vl-string-search "/" tempStr)
                                                5
                                            )
                                            (t 2)
                                        )
                                    )
                                    (setq tempPrec
                                        (if (equal rtosType 2)
                                            (if (setq tempPos (vl-string-search "." tempStr))
                                                (strlen (substr tempStr (+ 2 tempPos)))
                                                0
                                            )
                                            (if (setq tempPos (vl-string-search "/" tempStr))
                                                (WhatExponent (atoi (substr tempStr (+ 2 tempPos))) 2)
                                                0
                                            )
                                        )
                                    )
                                    (list
                                        "Real"
                                        tempStr
                                        rtosType
                                        (if (> basePrec tempPrec)
                                            basePrec
                                            tempPrec
                                        )
                                    ) ;(distof tempStr 4)
                                )
                                (cons "Int" tempStr) ;(atoi tempStr)
                            )
                            EndList
                        )
                    )
                    (setq bIsDigit nil)
                    (setq tempStr cStr)
                )
            )
            (if (<= 48 cAscii 57)
                (progn
                    (setq EndList (cons tempStr EndList))
                    (setq bIsDigit T)
                    (setq tempStr cStr)
                )
                (setq tempStr (strcat tempStr cStr))
            )
        )
        (setq cnt (1+ cnt))
    )
    (reverse
        (cons
            (if (<= 48 cAscii 57)
                (if
                    (or
                        (vl-string-search "." tempStr)
                        (vl-string-search "/" tempStr)
                        (vl-string-search "-" tempStr)
                        (vl-string-search "'" tempStr)
                    )
                    (progn
                        (setq rtosType
                            (cond
                                ((vl-string-search "'" tempStr)
                                    4
                                )
                                ((vl-string-search "/" tempStr)
                                    5
                                )
                                (t 2)
                            )
                        )
                        (setq tempPrec
                            (if (equal rtosType 2)
                                (if (setq tempPos (vl-string-search "." tempStr))
                                    (strlen (substr tempStr (+ 2 tempPos)))
                                    0
                                )
                                (if (setq tempPos (vl-string-search "/" tempStr))
                                    (WhatExponent (atoi (substr tempStr (+ 2 tempPos))) 2)
                                    0
                                )
                            )
                        )
                        (list
                            "Real"
                            tempStr
                            rtosType
                            (if (> basePrec tempPrec)
                                basePrec
                                tempPrec
                            )
                        ) ;(distof tempStr 4)
                    )
                    (cons "Int" tempStr) ;(atoi tempStr)
                )
                tempStr
            )
            EndList
        )
    )
)
(defun AddNumbersTo ( inList inNum / testNum )
   
    (mapcar
        '(lambda (x)
            (if (equal (type x) 'LIST)
                (if (= (car x) "Real")
                    (if (setq testNum (distof (cadr x) 3))
                        (rtos (+ testNum inNum) (caddr x) (cadddr x))
                        (progn
                            (prompt (strcat "\n Could not translate: " (cadr x) " into a number."))
                            (cadr x)
                        )
                    )
                    (rtos (+ (atoi (cdr x)) inNum) 2 0)
                )
                x
            )
        )
        inList
    )
)
(defun WhatExponent ( num expNum / cnt tempNum )
   
    (setq cnt 1)
    (setq tempNum expNum)
    (while (< tempNum num)
        (setq tempNum (* tempNum expNum))
        (setq cnt (1+ cnt))
    )
    cnt
)
(defun c:Test (/ AddNum Sel Obj LowPrec)
   
    (if
        (and
            (setq AddNum (getstring T "\n Enter number to add: "))
            (setq LowPrec
                (cond
                    ((setq tempPos (vl-string-search "." tempStr))
                        (strlen (substr tempStr (+ 2 tempPos)))
                    )
                    ((setq tempPos (vl-string-search "/" tempStr))
                        (WhatExponent (atoi (substr tempStr (+ 2 tempPos))) 2)
                    )
                    (t 0)
                )
            )
            (setq AddNum (distof AddNum))
            (not (equal AddNum 0))
            (setq Sel (entsel "\n Select entity to add to: "))
            (setq Obj (vlax-ename->vla-object (car Sel)))
        )
        (vla-put-TextString Obj (apply 'strcat (AddNumbersTo (ParseStringDigit (vla-get-TextString Obj) LowPrec) AddNum)))
    )
    (princ)
)