[编程交流] 四舍五入LISP（需要帮助r

(defun round_number (xr n / )
(* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n))
)
(defun c:FX_Round_Numbers ( / js n_count ent dxf_ent dxf_lst)
(setq su (getvar 'SNAPUNIT))
(setq tol (getreal "\nEnter the tolerance in X & Y: "))
(setvar "SNAPUNIT" (list tol tol))
(setq js (ssget '((0 . "FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,POINT,SHAPE,SOLID,TRACE"))) n_count -1)
(cond
        (js
                (setvar "cmdecho" 0)
                (command "_.undo" "_group")
                (while (setq ent (ssname js (setq n_count (1+ n_count))))
                        (setq dxf_ent (entget ent))
                        (cond
                                ((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
                                        (setq dxf_lst (cdr dxf_ent) dxf_ent (list (car dxf_ent)))
                                        (while (cdr dxf_lst)
                                                (if (eq 10 (caar dxf_lst))
                                                        (setq dxf_ent (cons (cons 10 (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdar dxf_lst) (getvar "SNAPUNIT"))) dxf_ent))
                                                        (setq dxf_ent (cons (car dxf_lst) dxf_ent))
                                                        )
                                                (setq dxf_lst (cdr dxf_lst))
                                                )
                                        (setq dxf_ent (reverse dxf_ent))
                                        )
                                ((eq (cdr (assoc 0 dxf_ent)) "POLYLINE")
                                        (while (eq (cdr (assoc 0 (setq dxf_ent (entget (entnext (cdar dxf_ent)))))) "VERTEX")
                                                (setq dxf_ent (subst (cons 10 (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdr (assoc 10 dxf_ent)) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT")))))) (assoc 10 dxf_ent) dxf_ent))
                                                (entmod dxf_ent)
                                                )
                                        )
                                (T
                                        (foreach n dxf_ent
                                                (if (member (car n) '(10 11 12 13 40))
                                                        (if (listp (cdr n))
                                                                (setq dxf_ent (subst (cons (car n) (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdr n) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT")))))) (assoc (car n) dxf_ent) dxf_ent))
                                                                (setq dxf_ent (subst (cons (car n) (round_number (cdr n) (/ 1 (car (getvar "SNAPUNIT"))))) (assoc (car n) dxf_ent) dxf_ent))
                                                                )
                                                        )
                                                )
                                        )
                                )
                        (entmod dxf_ent)
                        (entupd ent)
                        )
                
                ;; TEST CODE TO UPDATE THE HATCH
                (command "_.move" (entlast) "" '(0 0 1e99) ""
                                                "_.move" "_p" "" '(0 0 -1e99) "")
                                                
                                                
                (command "_.undo" "_end")
                (setvar "cmdecho" 1)
                (setvar "SNAPUNIT" su)
                (princ (strcat "\n" (itoa n_count) " transformed objects (s)."))
                )
        (T (princ "\nNo found valid object ."))
        )
(prin1)
)