round up area lisp routine

[bogeymen77]

Hi,

I'm looking to add a round up routine in a dimension area routine. i saw a few roud up codes but i don't know were to insert them or if it going to work.

here's the area dimension code that we use. 

We need to  have the answer round up to the next .5:

12,02 = 12,5

12,4 = 12,5

12,51=13

12,65=13

etc..

 

thank you for your help.

 

;;; Dimension Area  
;;; Displays the area calculated from the selection of two Dimensions in an
;;; MText Field Expression using the formatting specified at the top of the code.

(defun c:aaa ( / *error* _SelectIf _ObjectID Round acdoc acspc d1 d2 fieldformatting msg predicate pt )

    (setq fieldformatting "%lu2%ct4%qf1 PC ") ;; Field Formatting

    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
	(defun Round (num dp / fac rm)
   (setq fac (float (expt 10 dp))
         rm  (rem (setq num (* fac num)) 1)) 
   
   (/ (cond (  (zerop rm) (fix num))
            
            (  (< 0.5 rm) (1+ (fix num)))
            
            (  (+ (/ 5 fac) (fix num)))) fac))
	
    (defun _SelectIf ( msg pred )
        (
            (lambda ( f / e )
                (while
                    (progn (setvar 'ERRNO 0) (setq e (car (entsel msg)))
                        (cond
                            (   (= 7 (getvar 'ERRNO))
                                (princ "\nMissed, try again.")
                            )
                            (   (eq 'ENAME (type e))
                                (if (and f (null (f e)))
                                    (princ "\nInvalid Object.")
                                )
                            )
                        )
                    )
                )
                e
            )
            (eval pred)
        )
    )
		
    (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
          acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace))
    )
    (setq _ObjectID
        (eval
            (list 'lambda '( obj )
                (if
                    (and
                        (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                        (vlax-method-applicable-p (vla-get-utility acdoc) 'getobjectidstring)
                    )
                    (list 'vla-getobjectidstring (vla-get-utility acdoc) 'obj ':vlax-false)
                   '(itoa (vla-get-objectid obj))
                )
            )
        )
    )
			
    (setq predicate
        (function
            (lambda ( x )
                (and
                    (eq (cdr (assoc 0 (setq x (entget x)))) "DIMENSION")
                    (member (boole 4 (+ 128 64 32) (cdr (assoc 70 x))) '(0 1))
                )
            )
        )
    )                     
	
	
    (while
        (and
            (setq d1 (_SelectIf "\nSelect 1st Dimension <Exit>: " predicate))
            (setq d2 (_SelectIf "\nSelect 2nd Dimension <Exit>: " predicate))
            (setq pt (getpoint "\nPoint for Result <Exit>: "))
        )
        (vla-addmtext acspc (round (vlax-3D-point (trans pt 1 0))) 0.0
            (strcat
                "%<\\AcExpr "
                "%<\\AcObjProp Object(%<\\_ObjId "
                (_ObjectID (vlax-ename->vla-object d1)) ">%).Measurement>% * "
                "%<\\AcObjProp Object(%<\\_ObjId "
                (_ObjectID (vlax-ename->vla-object d2)) ">%).Measurement>% "
                "\\f \"" fieldformatting "\">%"
            )
        )
    )

    (princ)
)
(vl-load-com) (princ)

 

[Stefan BMR]

Hi

 

Your rounding function is useless here. You have to round the numbers inside AcExpr expression. However, inside AcExpr you have to use the original values then apply the conversion factor to the result.

Try this:

;;; Dimension Area  
;;; Displays the area calculated from the selection of two Dimensions in an
;;; MText Field Expression using the formatting specified at the top of the code.

(defun c:aaa ( / *error* _SelectIf _ObjectID  acdoc acspc d1 d2 fieldformatting msg predicate pt )

    (setq fieldformatting "%lu2%pr2%ps[, PC]") ;; Field Formatting

    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
	
	
    (defun _SelectIf ( msg pred )
        (
            (lambda ( f / e )
                (while
                    (progn (setvar 'ERRNO 0) (setq e (car (entsel msg)))
                        (cond
                            (   (= 7 (getvar 'ERRNO))
                                (princ "\nMissed, try again.")
                            )
                            (   (eq 'ENAME (type e))
                                (if (and f (null (f e)))
                                    (princ "\nInvalid Object.")
                                )
                            )
                        )
                    )
                )
                e
            )
            (eval pred)
        )
    )
		
    (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
          acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace))
    )
    (setq _ObjectID
        (eval
            (list 'lambda '( obj )
                (if
                    (and
                        (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                        (vlax-method-applicable-p (vla-get-utility acdoc) 'getobjectidstring)
                    )
                    (list 'vla-getobjectidstring (vla-get-utility acdoc) 'obj ':vlax-false)
                   '(itoa (vla-get-objectid obj))
                )
            )
        )
    )
			
    (setq predicate
        (function
            (lambda ( x )
                (and
                    (eq (cdr (assoc 0 (setq x (entget x)))) "DIMENSION")
                    (member (boole 4 (+ 128 64 32) (cdr (assoc 70 x))) '(0 1))
                )
            )
        )
    )                     
	
	
    (while
        (and
            (setq d1 (_SelectIf "\nSelect 1st Dimension <Exit>: " predicate))
            (setq d2 (_SelectIf "\nSelect 2nd Dimension <Exit>: " predicate))
            (setq pt (getpoint "\nPoint for Result <Exit>: "))
        )
        (vla-addmtext acspc (vlax-3D-point (trans pt 1 0)) 0.0
            (strcat
                "%<\\AcExpr "
                "0.5*round("
                "%<\\AcObjProp Object(%<\\_ObjId "
                (_ObjectID (vlax-ename->vla-object d1)) ">%).Measurement>%*"
                "%<\\AcObjProp Object(%<\\_ObjId "
                (_ObjectID (vlax-ename->vla-object d2)) ">%).Measurement>%"
                "/72+0.49999999) "
                "\\f \"" fieldformatting "\">%"
            )
        )
    )

    (princ)
)
(vl-load-com) (princ)

 

[bogeymen77]

thank you seem to work perfectly.

[bogeymen77]

okay it work fine. thank  you....

But now... i got an other issue... i use this lee mac code to have a total of different dimension area. And if i use the code that you gave me the total is really not good.

like if i got a square of 12 inch by 12 inch =1 sqf

a square of 13 x 13 = 1.1736... with the rouded area : 1.5 sqf

total of those 2 square:

whitout rounding : 2,1736sqf

whit rounding : 0,0174 sqf

 

here's the lee mac code (we can change for an other code if needed)

 

thanks again.

;; Add Fields  -  Lee Mac  -  2011  -  www.lee-mac.com
;; Creates an MText Field displaying the result of summing selected MText fields,
;; formatted using the field formatting code specified at the top of the program.
;; Selected fields must reference numerical data.

(defun c:af ( / _SelectIf fieldformatting fld fldexpr items mtx pos pt )

    (setq fieldformatting "%lu2%ct4%qf1 SQ. FT.") ;; Field Formatting

    (defun _SelectIf ( msg pred )
        (
            (lambda ( f / e )
                (while
                    (progn (setvar 'ERRNO 0) (setq e (car (entsel msg)))
                        (cond
                            (   (= 7 (getvar 'ERRNO))
                                (princ "\nMissed, try again.")
                            )
                            (   (eq 'ENAME (type e))
                                (if (and f (null (f e)))
                                    (princ "\nInvalid Object.")
                                )
                            )
                        )
                    )
                )
                e
            )
            (eval pred)
        )
    )

    (setq fldexpr "%<\\AcExpr "
          items   0
    )
    (while
        (setq mtx
            (_SelectIf "\nSelect Numerical MText Field: "
                (function
                    (lambda ( x )
                        (and
                            (eq "MTEXT" (cdr (assoc 0 (entget x))))
                            (LM:HasField-p x)
                        )
                    )
                )
            )
        )
        (setq fld (vla-fieldcode (vlax-ename->vla-object mtx)))

        (if (setq pos (vl-string-search "\\f" fld))
            (setq fld (strcat (substr fld 1 pos) ">%"))
        )
        (setq fldexpr (strcat fldexpr fld " + ")
              items   (1+ items)
        )
    )
    (if
        (and
            (< 0 items)
            (setq pt (getpoint "\nPoint for Result: "))
        )
        (vla-addmtext
            (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
                (if (= 1 (getvar 'CVPORT))
                    'paperspace
                    'modelspace
                )
            )
            (vlax-3D-point (trans pt 1 0)) 0.0
            (if (= 1 items)
                (strcat (substr fldexpr 11 (- (strlen fldexpr) 13)) " \\f \"" fieldformatting "\">%")
                (strcat (substr fldexpr  1 (- (strlen fldexpr)  2))  "\\f \"" fieldformatting "\">%")
            )
        )
    )
    (princ)
)