Search the Community

I got this LISP a long time ago and forget where it originated from. It rounds of "FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,POINT,SHAPE,SOLID,TRACE". But I would like it to also round of the point of dimensions so they are at the same location as the newly positioned endpoints of the lines/polylines etc. See here what dim point I refer to. I don't know where to start to get that working. Thanks. (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) )

Here's the code originally written by David Forbus (Thank you btw). Any help will be appreciated in helping me to fix the hatch issue. Thanks. ;;; QUANTALL ;;; Written by David Forbus 09_dec_2008 ;;; QUANTALL prompts a user for a Quantize Value ;;; QUANTALL then prompts a user for a selection set and then ;;; modifies the INSERTION POINTS of TEXT, MTEXT, CIRCLES, BLOCKS, LINES and LWPOLYLINES within that selection set so they all "snap" to quantized coordinates. ;;; Modified by 3dwannab (get OSNAP settings) 14.06.02 (defun QUANTLN () (setq SP-X (/ (cadr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 10 CURENT)) QUANT-VALUE )) (setq EP-X (/ (cadr (assoc 11 CURENT)) QUANT-VALUE )) (setq EP-Y (/ (caddr (assoc 11 CURENT)) QUANT-VALUE )) (setq EP-Z (/ (cadddr (assoc 11 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (if (>= (- EP-X (fix EP-X)) 0.5) (setq EP-X (* QUANT-VALUE (+ 1.0 (fix EP-X)))) (setq EP-X (* QUANT-VALUE (fix EP-X)))) (if (>= (- EP-Y (fix EP-Y)) 0.5) (setq EP-Y (* QUANT-VALUE (+ 1.0 (fix EP-Y)))) (setq EP-Y (* QUANT-VALUE (fix EP-Y)))) (if (>= (- EP-Z (fix EP-Z)) 0.5) (setq EP-Z (* QUANT-VALUE (+ 1.0 (fix EP-Z)))) (setq EP-Z (* QUANT-VALUE (fix EP-Z)))) (setq CURENT (subst (list 10 SP-X SP-Y SP-Z) (assoc 10 CURENT) CURENT )) (setq CURENT (subst (list 11 EP-X EP-Y EP-Z) (assoc 11 CURENT) CURENT )) (entmod CURENT) ) (defun QUANTPOLY () (setq COUNTER2 1) (setq POLY-NEW (list)) (while (< COUNTER2 (length CURENT)) (setq VRTX-PNT (nth COUNTER2 CURENT)) (if (= 10 (car VRTX-PNT)) (progn (setq SP-X (/ (cadr VRTX-PNT) QUANT-VALUE )) (setq SP-Y (/ (caddr VRTX-PNT) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (setq POLY-NEW (append POLY-NEW (list (list 10 SP-X SP-Y))))) (if (= 330 (car VRTX-PNT)) nil (if (= 5 (car VRTX-PNT)) nil (setq POLY-NEW (append POLY-NEW (list VRTX-PNT)))) ) ) (setq COUNTER2 (+ COUNTER2 1)) ) (entmake POLY-NEW) (entdel CURENT-NAME) ) (defun QUANTREG () (setq SP-X (/ (cadr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 10 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (setq CURENT (subst (list 10 SP-X SP-Y SP-Z) (assoc 10 CURENT) CURENT )) (entmod CURENT) ) (defun QUANTXT () (setq TXT-HORZ (cdr (assoc 72 CURENT))) (setq TXT-VERT (cdr (assoc 73 CURENT))) (if (= TXT-HORZ 0) (if (= TXT-VERT 0) (progn (setq SP-X (/ (cadr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 10 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (setq CURENT (subst (list 10 SP-X SP-Y SP-Z) (assoc 10 CURENT) CURENT )) ) (progn (setq SP-X (/ (cadr (assoc 11 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 11 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 11 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (setq CURENT (subst (list 11 SP-X SP-Y SP-Z) (assoc 11 CURENT) CURENT )) ) ) (progn (setq SP-X (/ (cadr (assoc 11 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 11 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 11 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (setq CURENT (subst (list 11 SP-X SP-Y SP-Z) (assoc 11 CURENT) CURENT )) )) (entmod CURENT) ) (defun QUANTARC () (setq SP-X (/ (cadr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 10 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (setq CURENT (subst (list 10 SP-X SP-Y SP-Z) (assoc 10 CURENT) CURENT )) (setq RAD-R (/ (cdr (assoc 40 CURENT)) QUANT-VALUE )) (if (>= (- RAD-R (fix RAD-R)) 0.5) (setq RAD-R (* QUANT-VALUE (+ 1.0 (fix RAD-R)))) (setq RAD-R (* QUANT-VALUE (fix RAD-R)))) (setq CURENT (subst (cons 40 RAD-R) (assoc 40 CURENT) CURENT )) (entmod CURENT) ) (defun c:Fix_Quantize_All ( / osnap ) ;;3dwannab fix (setvar "cmdecho" 0) (setq OSNAP (getvar "osmode")) ;;3dwannab fix (setvar "osmode" 0) (setq QUANT-VALUE (getreal "\nEnter Quantize Value: ")) (setq SELECT-SET (ssget)) (setq COUNTER0 (1- (sslength SELECT-SET ))) (while (> COUNTER0 -1.0) (setq CURENT (entget (ssname SELECT-SET COUNTER0))) (setq CURENT-NAME (ssname SELECT-SET COUNTER0)) (if (= (cdr (assoc 0 CURENT)) "LINE") (QUANTLN)) (if (= (cdr (assoc 0 CURENT)) "TEXT") (QUANTXT)) (if (= (cdr (assoc 0 CURENT)) "MTEXT") (QUANTREG)) (if (= (cdr (assoc 0 CURENT)) "INSERT") (QUANTREG)) (if (= (cdr (assoc 0 CURENT)) "CIRCLE") (QUANTREG)) (if (= (cdr (assoc 0 CURENT)) "ARC") (QUANTARC)) (if (= (cdr (assoc 0 CURENT)) "LWPOLYLINE") (QUANTPOLY)) (setq COUNTER0 (1- COUNTER0)) ) (princ) (setvar "osmode" OSNAP) ) (princ "\nType \"Fix_Quantize_All\" to Quantize the INSERTION POINTS of TEXT, MTEXT, CIRCLES, ARCs, BLOCKS, LINES and LWPOLYLINES to the round off value.")