四舍五入LISP（需要帮助r
我很早以前就知道这个Lisp程序了，忘了它是从哪里来的。它循环了“FACE3D、ARC、ATTDEF、ATTRIB、CIRCLE、ELLIPSE、INSERT、LINE、POLYLINE、LWPOLYLINE、*TEXT、POINT、SHAPE、SOLID、TRACE”。
但我希望它也能圆化尺寸点，使其与直线/多段线等的新定位端点位于同一位置。
看看这里我指的是什么暗点。
我不知道从哪里开始工作。
谢谢
(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)
)
页:
[1]