this code/tests is dated 2-19-2003 - including the functions by Joe and Doug....
(defun roundNum (num /)
(if (>= (abs (- num (fix num))) 0.5)
(if (minusp num)
(1- (fix num))
(1+ (fix num)))
(fix num)))
(defun roundTo (num to /)
(if (>= (abs (- num (fix num))) to)
(if (minusp num)
(* (/ (fix num) to) to)
(1+ (fix num))
)
(fix num)))
(roundTo -283.1 10)
(setq num 1.4 to 0.4)
(setq num -1.4 to 0.4)
(setq num -283.1 to 10)
(setq num -283.1 to -10)
(setq num -280.6 to -10)
(setq num -1.4 to 0.5)
(setq num -1.4 to -0.8)
(setq num -1.7 to -0.2)
(- 1.4 (rem 1.4 0.5))
(setq num 23321344.677812 to 18)
;; untested
;; (round2 -283.1 10) -> -280
;; (round2 -283.1 -10) -> -280
;; (round2 -283.1 40)
(defun round2 (num to /) (* (/ (fix num) to) to))
(defun round2 (num to /) (- (/ (fix num) to) to))
(rem 3 3.1)
(- 283 (rem 283 10))
(if (< (setq n (- 1.4 (rem 1.4 0.5))) 1.4) (+ n 0.5))
(if (< (setq n (- 283 (rem 283 10))) 283) (+ n 10))
(- 283 (rem 283 50))
(- 1.2 (rem 1.2 0.5))
(- 1.4 (rem 1.4 0.5))
(defun rx (num to) (+ (fix num) (rem to num)))
(setq num 1.4 to 0.5)
(round -283.1 30) -> 270
(round2 -283.1 30) -> -270
(round -283.1 40) -> 280
(round2 -283.1 40) -> -280
(round 1.4 0.5) -> 1.5
(round2 1.4 0.5)
;;DCB - modified due to catch by Joe Burke
(defun round (n to)
(* to
(fix
(/
((if (minusp n) - +)
(/ to 2.0) n) to))))
Command: (round -283.1 10)
-270
(setq n -1.4 to 0.5)
(round -1.4 0.5)
(roundNum -1.4 0.5)
(setq num -1.4 to 0.5)
(setq num -280.6 to -10)
(defun roundNum (num to /)
(if (>= (abs (- num (fix num))) to)
(if (minusp num)
(+ (1- (fix num)) to)
(- (1+ (fix num)) to))
(fix num)))
(+ (+ (abs (fix num)) to) to)
;Thanks Doug Broad and Joe Burke
(defun round (n to)
(setq to (abs to))
((if (minusp n) - +)
(* to (fix (/ (+ (/ to 2.0) (abs n)) to)))
)
)
(setq num -283.1 to 10)
(+ (fix (- num to)) (/ to 2.0))
Command: (round -283.1 10)
280
Command: (round -283.1 -10)
270
Should return -280 in both cases?
; *** num ***
(defun sq (x) (* x x))
(defun mag (x y z)
(sqrt (+ (sq x) (sq y) (sq z))))
(defun mag (x y z)
(- (sq x) (sq y) (sq z)))
(defun dist (p1 p2)
(mag (- (car p1) (car p2))
(- (cadr p1) (cadr p2))
(- (caddr p1) (caddr p2))))
(setq lst (list a b c d))
(setq px (mapcar '(lambda (pt) (mag (car pt) (cadr pt) (caddr pt))) lst))
(defun round (val unit)
(* unit (fix (/ ((if (minusp val) - +) val (* unit 0.5)) unit)))
)
(acet-calc-round -283.1 -10)
(setq num 283.1)
(setq n 10)
(if (< (setq n (- 1.4 (rem 1.4 0.5))) 1.4) (+ n 0.5))
(if (< (setq n (- num (rem num n))) num) (+ n 10))
(setq num 1.2)
(setq n 0.5)
(setq num 283.1)
(setq n 10)
(setq num 285)
(setq n 5)
(setq num 0.9)
(setq n 1)
(setq num -283.1)
(setq n -10)
(cond
((and (<= n 0.5) (< (setq n (- num (rem num n))) num))
(+ n 0.5))
((and (not (minusp num)) (zerop (- num (rem num n))))
(1+ (fix num)))
((and (minusp num) (not (zerop (- num (rem num n)))))
(1- (fix num)))
(t (- num (rem num n))))
(round-to-fraction -283.1 -10)
(round-to-fraction 283.1 10)
(round-to-fraction 1.4 0.5)
(round-to-fraction 285 5)
(defun round-to-fraction (num n /)
(abs
(cond
((and (<= n 0.5) (< (setq n (- num (rem num n))) num))
(+ n 0.5))
((and (not (minusp num)) (zerop (- num (rem num n))))
(1+ (fix num)))
((and (minusp num) (not (zerop (- num (rem num n)))))
(- num (rem num n)))
(t (- num (rem num n))))))
;; ultima correccion de Doug.. sirve
(defun round (value to)
(setq to (abs to))
(* to
(fix (/ ((if (minusp value)
-
+)
value
(* to 0.5))
to))))
Sample data:
(round 283 10)
280
(round -283 10)
-280
(round -283 -10)
-280
(round 283 10.0)
280.0
(round 1.4 0.5)
(round 283.1 10)
;;;------------------------------------------------------------------------------
;;;;;;(setq num -283)
;;;;;;
;;;;;;object.AddDimRotated (XLine1Point, XLine2Point, DimLineLocation, RotationAngle)
;;;;;;
;;;;;;(entget ent)
;;;;;;
;;;;;;(setq obj (vlax-ename->vla-object ent))
;;;;;;
;;;;;;(vla-put-roundDistance obj 10)
;;;;;;(vla-get-measurement obj)
;;;;;;(vla-update obj)
(* (fix (/ 283.0 10)) 10)
(if (<= 0.5 0.5)
(- (fix (/ 1.4 0.5)) 0.5)
(* (fix (/ 283.0 10)) 10))
(setq num 1.4 n 0.5)
(setq num 283 n 10.0)
(not (zerop (- num (fix num))))
(defun round (num n)
(if (<= (rem num n) n)
(- (fix (/ num n)) n)
(* (fix (/ num n)) n)))
(setq num 283.1 n 10)
(setq num -283.1 n 30)
(setq num -283.1 n 40)
(acet-calc-round -283.1 40)
(round -283.1 0.0) ;revisar no division por cero
;;;(defun round (num n / x)
;;; ;; is a fraction?
;;; (if (and (not (zerop (setq x (- num (fix num)))))
;;; (not (equal x 0.1 0.0001)))
;;; (- (fix (/ num n)) n)
;;; (* (fix (/ num n)) n)))
(defun round (value to)
(setq to (abs to))
(* to
(fix (/ ((if (minusp value)
-
+)
value
(* to 0.5))
to))))
;; LE mi funcion de redondeo...
(defun round (num n / x)
(cond
((and (not (zerop (setq x (- num (fix num)))))
(not (equal x 0.1 0.0001))
(not (minusp x)))
(- (fix (/ num n)) n))
(t (* (fix (/ num n)) n))))
Command: (round -283.283283 0.001)
-283.283
Command: (round -283.283283 0.002)
-283.284
(acet-calc-round -283.283283 0.002)
(setq num -283.283283 n 0.002)